perm filename MUS10B.FAI[MUS,LCS]3 blob
sn#365819 filedate 1978-07-05 generic text, type T, neo UTF8
SUBTTL Outer Loop
; HERE IS THE OUTER LOOP OF THE WHOLE SYSTEM.
CHOWN1: PUSHJ P,INTER1 ;INTERPRET STATEMENT.
SCHOWN: PUSHJ P,SMSC1 ;GET FIRST NON-SEMICOLON.
MOVE JOBREL
MOVEM BEGFREE ;*****
SUB JOBFF
SKIPN GETMORE# ;DO WE NEED TO GET MORE?
CAIGE =1024 ;NO, DO WE HAVE AT LEAST 2K WORDS OF CORE?
COREFULL ;COREFULL WILL KINDLY GET US SOME MORE
SETZM GETMORE ;CLEAR CORE REQUEST FLAG
CHOWN: CAMN A,PLAYV ;IS IT A 'PLAY' SECTION ?
JRST PLAY1 ;YES.
CAMN A,ALTV ;IS IT AN ALT MODE ?
JRST COMMND ;YES. A COMMAND FOLLOWS.
CAMN A,EXTV ;AN EXTERNAL DECLARATION
JRST CHOWN2 ;YES, BETTER BE READY TO GENERATE CODE
CAME A,INSV ;IS IT A INSTRUMENT DEFINITIN?
CAMN A,FUNV ;A FUNCTION DEFINITION?
JRST [CHOWN2: PUSHJ P,SCOMP ;INIT. COMPILER
SETZ H,
PUSHJ P,(A) ;DO DEFINITION
PUSHJ P,ENDP1 ;CLEAN UP COMPILER
PUSHJ P,LOADER ;LOAD DEFINITION
JRST SCHOWN]
TLNE A,DF ;IS IT A DECLARATION?
TLNN A,DECLBIT
JRST CHOWN1 ;NO. JUST A STATEMENT.
PUSHJ P,(A) ;DO DECLARATION
CAMN A,SEMICV ;BETTER BE A SEMICOLON
JRST SCHOWN ;GO BACK FOR MORE
WARN(Missing ';')
JRST CHOWN
;A COMPILE BLOCK
COMPL1: PUSHJ P,SCOMP ;INIT. THE COMPILER.
PUSHJ P,SCAN
COMPL2: PUSHJ P,SMCS1 ;SCAN TO NEXT SEMICOLON
CAME A,FINV ;A FINISH?
CAMN A,FINIV ;OR A 'FINI'?
JRST COMPDN
TLNE A,DF ;A DECLARATION?
TLNN A,DECLBIT
JRST [WARN <A simple statement inside a 'COMPILE' section just wastes space!>
COMMENT ⊗ It will never be executed. ⊗;
PUSHJ P,STAT ;EAT IT ANYWAY...
JRST COMPL3]
PUSHJ P,(A) ;YES, DO IT
COMPL3: CAME A,SEMICV ;BETTER BE A SEMICOLON
WARN <Missing ';'> ;OH, WELL...
JRST COMPL2
COMPDN: PUSHJ P,ENDP1 ;DONE WITH COMPILATION
PUSHJ P,LOADER ;LOAD THE CODE.
JRST SCHOWN ;DONE WITH THAT SECTION.
PLAY1: SETZ A,
RUNTIM A,
MOVEM A,RUNTIM# ;SAVE FOR STATISTICS LATER
TIMER A,
MOVEM A,BEGTIM#
PUSHJ P,PLINIT ;WE'RE GOING TO PLAY; GET SAMPLE BUFFER.
AOS SBCNT
LDB A,[POINT 6,SBPTR,11];Calculate maximum possible sample
SETO 0, ;from byte size for output
LSH 0,-1(A)
SETCAM 0,OVRSMP# ;Remember it somewhere
PLAY1A: SETZM TIME# ;T←0.
SETZM RQPTR# ;RUN QUEUE IS EMPTY.
SKIPN BLKNUM ;DON'T RESET MAXSMP IF APPENDING
SETZM MAXSMP# ;INIT. THE MAXIMUM SAMPLE REMEMBERER.
PLAY2: PUSHJ P,SMSC1 ;SCAN A NON-SEMICOLON.
CAMN A,FINIV ; A 'FINI'?
JRST PTERM
CAME A,FINV ;A 'FINISH ' ?
CAMN A,PLAYV ;... OR A 'PLAY' ?
JRST PTERM ;YES. END OF SECTION.
TLNE A,INSBIT ;AN INSTRUMENT NAME ?
JRST PINS ;YES. A NOTE STATEMENT.
PUSH P,[PLAY2] ;NO. INTERPRET THE STATEMENT.
INTER1: CAME A,INSV
CAMN A,FUNV
ERROR <NOT ALLOWED IN 'PLAY' SECTION>
PUSHJ P,SCOMPA ;IT MUST BE A RANDOM STATEMENT.
;PREPARE TO INTERPRET IT BY
;INITIALIZING THE COMPILER.
SETOM IONLY ;DON'T GENERATE R-TIME CODE AS ATTEMPTS TO DO
;SO CONFUSE THE COMPILER (SEE GM3)
PUSHJ P,STAT ;COMPILE THE STATEMENT.
;INTERPET THE CODE JUST COMPILED
INTERP: MOVE A,[JRST INTER2] ;PREPARE TO EXECUTE TEMPORARY
MOVEI B,0 ;CODE (I.E., RUN IN INTERPRET MODE).
PUSHJ P,@EMITB(H);EMIT RETURN INSTR. AT END OF CODE.
PUSHJ P,ENDP1 ;CLEAN UP COMPILER.
PUSH P,JOBFF ;SAVE FREE STG. PTR. *****
PUSHJ P,LOADER ;LOAD THE TEMPORARY CODE.
MOVEM P,PSV1# ;SAVE IT.
MOVEM FL,FLSV1#
JRST @(P) ;EXECUTE IT.
INTER2: MOVE P,PSV1 ;RESTORE PUSHDOWN POINTER.
MOVE FL,FLSV1
POP P,0 ;RETRIEVE OLD STG. PTR.
HRRZM JOBFF ;FLUSH THE TEMP. CODE. *****
HRLM JOBSA ;(IT HAS TO GO HERE TOO.) *****
POPJ P, ;LOOK, MA, I'M AN INTERPRETER !!
SUBTTL PLAY Block Processor (PINS)
;THIS CODE READS A NOTE STATEMENT, INITIALIZES THE
; INSTRUMENT, AND GETS IT TURNED ON AT THE RIGHT TIME.
PINS: MOVE A,(A) ;GET STARTING ADDRESSES FOR INSTRUMENT.
PUSH P,(A) ;SAVE THEM.
MOVEI PBASE ;PREPARE TO FILL THE P ARRAY WITH
MOVEM PPTR1# ;THE PARAMETERS TO THE INSTR.
PUSHJ P,SCOMPA ;INIT. COMPLR. FOR POSSIBLE EXPRESSIONS.
MOVE NCHNS ;GET NO. OF OUTPUT CHANNELS.
TLNE -1 ;IS IT FLOATING ?
IFE KI10SW,< KAFIX 0,233000 >
IFN KI10SW,< KIFIX 0,0 >
PINS2: MOVEM I.NCHNS#
PUSH P,NUMBUC ;SAVE CURRENT STATE OF NUMBER
PUSH P,JOBFF ;BUCKET AND CORE TOP. *****
JRST PINSL ;INIT. THE COMPILER.
PINSL1: CAMN A,COMMAV ;OPTIONAL COMMA BETWEEN PARAMS...
PINSL: PUSHJ P,SCAN
AOS PPTR1 ;INCREMENT P-ARRAY POINTER.
CAMN A,COMMAV ;A COMMA HERE MEANS MISSING
JRST PINSL ;PARAM., SO DON'T CHANGE.
CAMN A,SEMICV ;SEMICOLON ?
JRST PINSB ;YES, END OF PARAMETERS.
TLNE A,SWVBT ;IS IT AN ARRAY NAME?
JRST [ PUSH P,A ;SAVE ARRAY NAME
PUSHJ P,SCAN ;PEEK AT NEXT ELEMENT
CAME A,LPARV ;IS IT A LEFT PAREN?
CAMN A,LFTBRK ;Or left bracket?
JRST [ MOVEM A,SNCHR ;Yes, evaluate it. (SNCHR FOR USE BY EXPR)
POP P,A ;RESTORE THE ARRAY NAME AND COMPILE AN EXPR
JRST PINSL2]
;THE ABOVE IS NOT SUFFICIENTLY GENERAL BUT WILL WORK WITH
;EXISTING FUNCTIONS AND UNIT GENERATORS
POP P,B ;NO, RESTORE THE ARRAY NAME
HRR B,(B) ;GET ITS ADDRESS
HRLI B,INSXR ;TURN ON APPROPRIATE INDEX REGISTER
;FOR UNIT GENERATOR
MOVEM B,@PPTR1 ;SAVE IT
JRST PINSL1] ;AND USE AS FORMAL PARAMETER
PINSL2: PUSHJ P,EXPR ;PARAMETER MAY BE EXPRESSION.
PUSH P,A ;SAVE SCANNED SYMBOL
PUSHJ P,GPONDER ;GET OPERAND POINTER FOR THE EXPR...
TLNE T,SIACBT ;IS VALUE OF EXPR AN AC SYMBOL ?
JRST PINS1 ;YES. IT HAS TO BE CALCULATED.
TLNE T,ARRYBT ;Is it an array reference?
TLNN T,17 ; Yes, if an index is given. Then evaluate it!
JRST PINSL4 ;No, prob. just variable
PUSH P,T ;Emit instruction to get it into an AC
PUSHJ P,GETAC ;Find an AC to put it in
POP P,B ;Will fix array element
MOVE C,[MOVE EMICDI]
PUSHJ P,EMINST ;Emit MOVE
JRST PINSA2 ;Then have it stored in P-ARRAY
PINSL4: POP P,A ;RESTORE SCANNED SYMBOL
PINSL3: MOVE C,(T) ;PICK UP ITS VALUE.
MOVEM C,@PPTR1 ; SO PUT ITS VALUE IN P-ARRAY NOW.
JRST PINSL1
PINS1: ;EXPR. GENERATED SOME CODE, EVIDENTLY.
MOVE A,T ;EMIT AN INSTRUCTION TO STORE THE
PINSA2: MOVE B,PPTR1 ;RESULTANT VALUE IN THE P-ARRAY.
MOVE C,[MOVEM EMICDI]
PUSHJ P,EMINST ;THE CODE WILL GET EXECUTED
PUSHJ P,INTERP ; RIGHT NOW.
PUSHJ P,SCOMPA
POP P,A ;RESTORE SCANNED SYMBOL
JRST PINSL1 ;BACK FOR MORE PARAMS.
; More of PINS
PINSB:
POP OSP,BEGFREE ;FLUSH COMPLR. OUTPUT BUFFERS. *****
POP P,0 ;RECOVER OLD CORE TOP.
MOVEM JOBFF ;RESET THINGS TO FORGET *****
HRLM JOBSA ;ABOUT THE NUMBERS WE DEFINED WHILE *****
POP P,NUMBUC ;SCANNING NOTE PARAMETERS.
MOVE A,SRATE ;GET NO. OF SAMPLES/SEC.
MOVE B,PBASE+1 ;GET STARTING TIME FOR NOTE.
FMPR B,A ;CONVERT TO SAMPLES.
;;; FIXR B,B
;;; MOVEM B,RQ1 ;PLACE AT BOTTOM OF RUN QUEUE.
FIXR T,B
MOVEM T,RQ1 ;PLACE AT BOTTOM OF RUN QUEUE.
FMPR A,PBASE+2 ;GET DURATION OF NOTE IN SAMPLES.
FADR A,B ;ENDING TIME
FIXR A,A ;IN SAMPLES
;;; FIXR A,A
;;; ADD A,B ;CALC. ENDING TIME OF NOTE.
PUSH P,A ;SAVE SAME.
PUSHJ P,PLAYIT ;PLAY UP TO STARTING TIME OF NOTE.
PLYON: AOS A,RQPTR ;NOW TURN INSTRUMENT ON.
POP P,RQ1(A) ;PUT ENDING TIME IN RUNQUEUE, COL. ONE.
HLRZ T,(P) ;LET'S CHECK TO SEE IF HE'S TRYING TO RUN THE SAME
MOVEM T,LSTINS#
MOVE T,A ;INSTRUMENT AT THE SAME TIME!
PLYON2: SOJL T,PLYON3 ;TEST FOR END OF SEARCH
HRRZ RQ2(T)
CAME LSTINS ;IS IT THE SAME?
JRST PLYON2 ;NO
WARN (You are calling an instrument which is already running!)
COMMENT ⊗ Since the code generated for instruments is non-reentrant,
you should not call it with overlapping time periods as this will
produce unpredicable results. Instead you should make a copy of with
a different name (and different variable names if they are declared outside
that instrument). ⊗;
PLYON3: POP P,T ;GET STARTING ADDR. OF INSTRUMENT.
HLRZM T,RQ2(A) ;PLACE IN RUN QUEUE, COL. TWO.
PUSHJ P,(T) ;EXECUTE THE I-TIME CODE.
JRST PLAY2 ;BACK FOR MORE NOTE STATEMENTS.
DSKDAC: 1
PTERM: PUSH P,A ;HERE AT A 'PLAY' OR 'FINISH'.
MOVSI 200000
MOVEM RQ1 ;SET UP FAKE STARTING TIME.
PUSHJ P,PLAYIT ;FLUSH THE RUN QUEUE.
POP P,A
CAMN A,PLAYV ;WAS IT A 'PLAY' THAT WE SAW ?
JRST PLAY1A ;YES. START NEW SECTION.
MOVE F,PLYOPT
PUSHJ P,@FINTAB(F);NO, A 'FINISH'. EMPTY THE LAST BUFFER
IFE KI10SW,< MOVE A,BITS
KAFIX A,233000 >
IFN KI10SW,< KIFIX A,BITS >
TYPSTR [ASCIZ/ Bits = /]
PUSHJ P,DECPNT
IFE KI10SW,< MOVE A,SRATE
KAFIX A,233000 >
IFN KI10SW,< KIFIX A,SRATE >
TYPSTR [ASCIZ/ Srate = /]
PUSHJ P,DECPNT
TYPSTR[ASCIZ/
/]
SETZ A,
RUNTIM A,
SUB A,RUNTIM
FSC A,233
FDVRI A,(1000.0) ;CONVERT RUN TIME TO SECONDS
MOVEM A,RUNTIM
PUSHJ P,OUTFLT
TYPSTR [ASCIZ/Seconds run time /]
TIMER 0,
SUB 0,BEGTIM
FSC 0,233
FDVRI 0,(60.0)
MOVE A,RUNTIM
FDVR A,0
FMPRI A,(100.0)
PUSHJ P,OUTFLT
MOVEI [ASCIZ/% PL 1:/]
JSR TXTOUT
MOVE 0,TIME
FSC 0,233
FDVR 0,SRATE
MOVE A,RUNTIM
FDVR A,0
PUSHJ P,OUTFLT
MOVEI [ASCIZ/Compute ratio/]
JSR TXTOUT
SKIPE SAVCNT
TYPSTR [ASCIZ/
***** PLEASE DELETE .SAV FILE *****/]
OUTPUT TTY, ;FLUSH THE OUTPUT BUFFER
TYPSTR[ASCIZ/
/]
DACLP: JRST CPLAY ; Yes, do it
; 'PLAYIT' GENERATES SAMPLES BY CALLING THE
; INSTRUMENTS IN THE RUN QUEUE UNTIL IT IS TIME
; TO TURN ON THE INSTRUMENT WHOSE STARTING TIME IS
; IN THE ZEROTH LOCATION OF THE QUEUE, WHEN IT RETURNS.
; INSTRUMENTS ARE TURNED OFF AS REQUIRED.
IOACT←←10000 ;BIT IN DDB INDICATING I/O ACTIVE
PLAYIT: MOVE A,RQPTR ;SEARCH FOR EARLIEST TIME IN QUEUE.
PLYT2: MOVEM A,PTMP# ;SAVE ITS LOCATION.
SKIPA H,RQ1(A) ;PICK IT UP.
CAMG H,RQ1(A) ;A NEW MINIMUM ?
SOJGE A,.-1 ;NO.
JUMPGE A,PLYT2 ;YES.
PLYT1: CAMN H,[XWD 200000,0] ;MIN. FOUND. IS IT THE TERMINATION
POPJ P, ; MARK ? IF YES, THEN RETURN.
SUB H,TIME ;IT'S NOT . CALC. DISTANCE IN FUTURE.
JUMPLE H,PLYT3 ;IF NOT IN FUTURE, FORGET IT.
ADDM H,TIME ;MOVE TIME TO NEW VALUE.
PLYT4: SKIPE OSP,RQPTR ;CYCLE THRU RUNNING INSTRS., IF ANY.
PUSHJ P,@RQ2(OSP) ;CALL AN INSTR.
JFCL 1,.+1
SOJG OSP,.-2 ;CALL THEM ALL.
MOVEI F,1 ;START WITH CHANNEL 1.
PLYT5: SOSLE SBCNT ;COUNT SAMPLE BUFFER COUNTER.
JRST .+4
EXCH F,PLYOPT ;SAVE F AND SET OPTION
PUSHJ P,@OUTTAB(F);FLUSH FULL BUFFER.
EXCH F,PLYOPT ;SAVE OPTION AND RESTORE F
MOVE B,OUTA-1(F) ;PICK UP NEXT CHANNEL'S SAMPLE, AND
IFE KI10SW,<
FAD B,[0.5] ;ROUND TO NEAREST INTEGER.
KAFIX B,233000 ;A. KOTOK SHOULD HAVE DONE THIS.
>;IFE KI10SW
IFN KI10SW,<
FIXR B,B ;It's about time (and it isn't even as good)
>;IFN KI10SW
CAIN B,400000 ;DON'T OUTPUT TRAILER CODE
ADDI B,1 ;IT'S TOO SMALL ANYWAY...
MOVM A,B ;GET MAGNITUDE...
CAMLE A,MAXSMP ;IS THIS SAMPLE THE BIGGEST YET ?
JRST [ CAMLE A,OVRSMP ;Check for larger than byte size
JRST [ OUTSTR[ASCIZ/Channel /]
MOVE A,F
PUSHJ P,DECPNT
OUTSTR[ASCIZ/ Value /]
MOVE A,OUTA-1(F)
PUSHJ P,OUTFLT
WARN<OUTn too big, clipped> ;Tell loser about it
COMMENT ⊗ Sample just computed was too big to represent in the byte size
currently being used for output. This usually is indicative of some
problem in an instrument. ⊗;
JUMPL B,[MOVN B,OVRSMP
MOVNM B,MAXSMP
JRST .+1 ]
MOVE B,OVRSMP
MOVEM B,MAXSMP
JRST .+1] ;And let him continue
MOVEM A,MAXSMP ;A new MAXSMP
JRST .+1 ]
IDPB B,SBPTR ;PLACE IT IN SAMPLE BUFFER.
SETZM OUTA-1(F) ;ZERO UP THIS CHANNEL'S NEXT SAMPLE
CAMGE F,I.NCHNS ;LAST CHANNEL ?
AOJA F,PLYT5 ;NO. GET OTHER CHANNELS.
MOVE A,@MTSYSA ;GET WORD TO SEE IF WE WANT TO 'INTERRUPT` TO
SOJG H,PLYT4 ;GENERATE REST OF SAMPLES.
PLYT3: SKIPG A,PTMP ;GET PTR. TO NEXT INSTR. OFF OR ON.
POPJ P, ;TIME TO TURN ONE ON.
SOS B,RQPTR ;REMOVE INSTR. FROM QUEUE.
MOVE RQ1+1(B) ;MOVE TOP ENTRY DOWN INTO VACANT
MOVEM RQ1(A) ;SPOT.
MOVE RQ2+1(B)
MOVEM RQ2(A)
JRST PLAYIT ;GO PLAY TILL NEXT EVENT.
SUBTTL UUOSER - User UUO service
BEGIN UUOSER
;Caution: UUO's called by error routine better not use UUOPDL!!!
↑UUOSER: 0
SETOM INUUO
MOVEM P,SAVEP#
LDB P,[POINT 6,40,8] ;GET OPCODE
CAIG P,UUOMAX
JUMPGE P,@UUOTAB(P)
UUOERR: MOVE P,UUOIOWD
PUSH P,UUOSER
OUTSTR [ASCIZ/?ERROR
ILLEGAL USER UUO AT /]
SOS A,UUOSER
HRRZ A,A
PUSH P,A
PUSHJ P,OUTOCT
OUTSTR [ASCIZ/
↑C/]
CALLI 1,12
MOVE P,SAVEP
SETZM INUUO
POPJ P,
UUORET: MOVE P,SAVEP
SETZM INUUO
JRSTF @UUOSER
;TYPCHR AND TYPSTR --- TYPE A CHARACTER AND TYPE A STRING
↑.TYPCHR: MOVE P,@40 ;THESE ARE SO THAT A DIFFERENT DEVICE
SOSGE TOB+2 ;THAN TTY COULD BE USED.
OUTPUT TTY,
IDPB P,TOB+1
JRST UUORET
↑.TYPSTR: MOVEI P,440700
HRLM P,40
TYPST2: ILDB P,40
JUMPE P,[ OUTPUT TTY,
JRST UUORET]
SOSGE TOB+2
OUTPUT TTY,
IDPB P,TOB+1
JRST TYPST2
↑.ERRUUO:MOVE P,SAVEP
BEND UUOSER
JSR SAVE
MOVE P,UUOIOWD
LDB 15,[POINT 4,40,12]
CAILE 15,11
SETZ 15,
OUTSTR@[[ASCIZ/Dryrot: /] ;0
[ASCIZ/Error: /] ;1
[ASCIZ/Warn: /] ;2
[ASCIZ/Warn: /] ;3
[ASCIZ/Unexpect error, may be problem with system: /] ;4
[ASCIZ/Dryrot: /] ;5 ;UNDEFINED AC FIELD
[ASCIZ/Dryrot: /] ;6 ;UNDEFINED AC FIELD
[ASCIZ/Dryrot: /] ;7 ;UNDEFINED AC FIELD
[ASCIZ/Debug: /] ;10
[ASCIZ/Debug: /] ;11
](15)
OUTSTR @40
SETOM INERR#
MOVE 1,UUOSER
SETZM INUUO
MOVEM 1,ERRPC
ERR7: JSR ERR2
CAIN 15,3 ;Skip warning?
AOSA ERRPC
CAIN 15,2 ;Non-skip warning
TDZA 15,15
SETO 15,
MOVEM 15,WARNFL#
JSR RESTORE
SETZM INUUO
JRST ERR99
UUOPDL: BLOCK 20
UUOIOW: IOWD .-UUOPDL,UUOPDL
SUBTTL Error Handling Routines.
EXTERNAL JOBOPC
INTEGER INUUO,INERR,LINCNT,PAGCNT,LINENO,NXTPAG,NXTLIN,ERRPC
;INTEGER INUUO,INERR,LINCNT,PAGCNT,LINENO,NXTPAG,NXTLIN,NOMSG,ERRPC,IWARN
COMMENT ⊗
↓INUUO: 0
↓LINCNT: 0
↓PAGCNT: 0
↓LINENO: 0
↓NXTPAG: 377777
↓NXTLIN: 377777
;↓NO.MSG: 0
; 0 ;TO TERMINATE OUTSTR
⊗;
ERR99: MOVE 1,WARNFL
OUTSTR @1+[[ASCIZ/??/]
[ASCIZ/→→/]
[0]
[ASCIZ/↔/]](1)
SKIPG WARNFL ;GO DIRECTLY TO ERR96 IF NOT DEBUGGING
JRST ERR96
SOSN WARNFL ;DON'T STOP FOR DEBUG MODE 1
JRST ERR97
ERR96: CLRBFI ;CLEAR TTY INPUT BUFFER
INCHWL 1
CLRBFI
CAIN 1,"α"
JRST ERR97 ;ALWAY CONTINUE!
CAIL 1,"a" ;FOR LOWER CASE
SUBI 1,40 ;CONVERT TO UPPER CASE
ERR98: CAIN 1,"S" ;RESTART?
JRST GO ;YES, RESTART
CAIN 1,"R" ;RETRY?
JRST [RETRY: MOVEI FL,RESTART
MOVEI 1
MOVEM RECCT ;SET USETI COUNT
MOVEM PAGCNT ;SET PAGE COUNT
MOVEM LINCNT ;SET PAGE COUNT
PUSHJ P,SETUP ;USE SAME FILE
SETZ FL,
JRST GOB] ;DO RESTART
SKIPL WARNFL ;CAN WE PROCEED
CAIE 1,15
JRST [ OUTSTR [ASCIZ/??/]
OUTSTR [ASCIZ/
S = START PROGRAM AGAIN, R = RETRY WITH SAME FILE./]
JRST ERR96]
ERR97: MOVE 1,ERSVAC+1
C.:
SETZM INERR
JRSTF @ERRPC
0
ERSVAC: BLOCK 20
ERR2: 0 ;ERROR MESSAGE PRINTER.
OUTSTR [ASCIZ/ Line = /]
MOVE A,LINCNT
SKIPE LINENO
OUTSTR LINENO ;FOR SOS FLAVOR OF LINE NUMBERS
SKIPN LINENO
PUSHJ P,OUTFLT
OUTPUT TTY,
OUTCHR ["/"]
MOVE A,PAGCNT
PUSHJ P,OUTFLT
OUTSTR [ASCIZ/
/];
; FIND OFFENDING LINE
SKIPE NOISCP ;Check for ISCP invalid
JRST ERR2Z
MOVE A,ISCP ;SET UP THREE POINTERS TO BEGINNING OF TEXT BUFFER
MOVE B,A ;TO BE USED TO FIND LINES PRECEDING ERROR
MOVE C,B
ERR2B: ILDB A ;SEARCH UNTIL <CR>
CAIE 15
JRST ERR2A
MOVE C,B ;<CR> FOUND, NOW REMEMBER WHERE IT IS
MOVE B,A
ERR2A: CAME A,SCP ;WAS IT WHERE WE FOUND THE ERROR?
JRST ERR2B ;NO, TRY AGAIN
JRST ERR2D ;YES, LET'S PRINT IT, STARTING THE PREVIOUS LINE
ERR2C: OUTCHR
ERR2D: ILDB C ;GET A CHARACTER
CAME C,SCP ;WAS IT WHERE THE ERROR WAS?
JRST ERR2C ;NO, PRINT IT AN GET ANOTHER
CAIE 14 ;DON'T OUTPUT FORM FEED!
OUTCHR ;PRINT IT TOO
ERR2E: SKIPN (A) ;AT END OF BUFFER?
JRST ERR2G ;YES
ILDB A
OUTCHR
CAIE 15
JRST ERR2E
ERR2G: OUTSTR [ASCIZ/
/]
CAMN B,SCP
JRST ERR2H
ERR2F: ILDB B ;NOW POINT TO ERROR
CAMN B,SCP ;AT ERROR?
JRST ERR2H ;YES, PRINT '↑` AND RETURN
JUMPE ERR2F ;IGNORE NULLS
CAIN 12
JRST ERR2F
CAIN 15
JRST .+3
CAIE 11 ;A TAB?
MOVEI " " ;NO, OUTPUT A SPACE THEN
OUTCHR
JRST ERR2F ;NO, TRY AGAIN
ERR2H: OUTCHR ["↑"]
ERR2Z: OUTSTR [ASCIZ/
/]
JRST @ERR2
;SAVE AND RESTORE ACS FOR ERROR ROUTINES
SAVE: 0
MOVEM 17,ERSVAC+17 ;SAVE AC'S
MOVEI 17,ERSVAC
BLT 17,ERSVAC+16
MOVE 17,ERSVAC+17
JRST @SAVE
RESTORE:0
MOVSI 17,ERSVAC ;RESTORE AC'S.
BLT 17,17
JRST @RESTORE
IGNOLF: CAIN 0,15
INCHRS 0
POPJ P,
POPJ P,
; Illegal array reference routine
; PRINTS OUT ARRAY NAME AND SUBSCRIPT VALUE
ILLARF: OUTPUT TTY, ;FLUSH TTY BUFFER
OUTSTR [ASCIZ/
Subscript of out bounds for array /]
JSR SAVE ;SAVE THE AC'S
MOVE A,@(P) ;GET POINTER TO GOODBITS WORD
PUSHJ P,PRNTSYM
TYPSTR [ASCIZ/, subscript = /]
JSR RESTORE
PUSH P,A
LDB A,[POINT 4,@-1(P),(17-5)]
MOVE A,ERSVAC(A)
POP P,(P)
ILLAR2: PUSHJ P,OUTFLT
SETOB 1,WARNFL
JRST ERR99
;P array error
BADARR: OUTPUT TTY, ;Flush TTY buffer
ERROR <Array expected in function or U.G. call, but number found instead.
Prob. argument to instrument wrong.>
COMMENT ⊗ Either a function or Unit Generator was called with a Pn symbol, which
should have be an array, but instead a floating point number was found. This
is usually caused by passing a number instead of an array in an instrument
call, or an error in the instrument with respect to the numbering of the
Pn arguments. ⊗;
SUBTTL Miscellaneous Cruft
UDIERR: ERROR (Undefined IDENTIFIER)
SILCH: WARN (Illegal character)
COMMENT ⊗ A character was found in file which has no meaning to the compiler. ⊗;
POPJ P, ;I HOPE THIS WORKS, IT MIGHT NOT
SNUMX1: ERROR (Illegal character in number);⊗ Not a digit or decimal point. ⊗;
FNDWV: PUSHJ P,DRYROT
↑PI: 3.14159265359;*RANDOM CONSTANTS- IS THERE A BETTER PLACE FOR THIS?
;;.SKIP.↑: 0 ;So as to avoid UNDEF EXTERNAL FROM FINC!
FOR @$ A IN (PW,COMM,EXP,ENDS,WHLS)
<A$OP: PUSHJ P,DRYROT
>
; *** WHERE ELSE SHOULD THIS GO?? ***
; DECIDES IF A SYMBOL IS A PROPER STATEMENT TERMINATOR AND SKIPS IF
; IT IS NOT A TERMINATOR
STMTRM: CAME A,SEMICV ;';`
CAMN A,ENDV ;OR 'END`
POPJ P,
CAME A,ELSEV ;OR 'ELSE`
CAMN A,UNTILV ;OR 'UNTIL`
POPJ P,
AOS (P)
POPJ P,
SUBTTL Lookup External in DDT Symbol Table
SYMSCH: MOVEI T,6 ;LOOK UP EXTERNAL SYMBOL.
MOVE [POINT 6,ACCUM,5] ;PREPARE TO CONVERT TO
MOVEI B,0
SYMS1: ILDB A,0 ;RADIX 50.
JUMPE A,SYMS4
CAIN A,16
MOVEI A,73
CAIG A,5
ADDI A,70
CAIGE A,32
ADDI A,7
IMULI B,50
ADDI B,-26(A)
SOJG T,SYMS1
SYMS4: TLO B,40000
MOVE A,116
SYMS3: AOBJP A,SYMS2
CAME B,-1(A)
AOBJN A,SYMS3
SYMS2: SKIPL A ;Is it present?
POPJ P, ; No, non-skip return means failure
HRRZ A,(A) ;Flush crud in left half
AOS (P) ;Skip return for success
POPJ P,
SUBTTL Unit Generators
;; HERE ARE SOME WONDERFUL UNIT GENERATORS.
BEGIN U.G.
COMMENT ⊗
CALLED WITH:
JSP RA,OSCIL
<Amplitude> ;0 (-5)
<Increment> ;1 (-4)
<Array>(INSXR) ;2 (-3)
<Temp - Sum> ;3 (-2)
⊗;
;;;↑OSCIL: MOVE INSXR,3(RA)
;;;IFE KI10SW,< KAFIX INSXR,233000 >
;;;IFN KI10SW,< KIFIX INSXR,INSXR >
IFE KI10SW,<
↑OSCIL: MOVE INSXR,3(RA)
KAFIX INSXR,233000 >
IFN KI10SW,<
↑OSCIL: KIFIX INSXR,3(RA) >
TRZE INSXR,777000
JSP T1,OSCIL1
MOVE T,@2(RA)
FMPR T,@(RA)
SKIPGE T1,@1(RA) ;OSCIL DOESN'T WANT NEG. INC.
JRST [ WARN (NEGATIVE INC. TO OSCIL)
COMMENT ⊗ OSCIL is not defined to go accept a negative increment however if
you continue from this error it will treat this increment as a NOSCIL does. ⊗;
JRST OSCILX]
OSCILX: FADM T1,3(RA)
JRST 4(RA)
OSCIL1↑:MOVSI (-512.0) ;WRAP AROUND THE POINTER.
JUMPGE INSXR,.+2
MOVNS 0 ;IF NEG. INC., WRAP AROUND OTHER WAY.
FADM 3(RA)
;; HRLI INSXR,0 ;INSERTED 1/25/71 TO ALLOW ZOSCIL=NOSCIL
JRST (T1)
↑NOSCA: ADDI RA,1 ;SEE INOSCA
IFE KI10SW,<
↑NOSCIL:MOVE INSXR,3(RA) ;SAME AS OSCIL EXCEPT IT WILL TAKE NEG. INC
KAFIX INSXR,233000 >
IFN KI10SW,<
↑NOSCIL:KIFIX INSXR,3(RA) >
TRZE INSXR,777000
JSP T1,OSCIL1
MOVE T,@2(RA)
FMPR T,@(RA)
MOVE T1,@1(RA)
FADM T1,3(RA)
JRST 4(RA)
IFE KI10SW,<
↑FOSCIL:MOVE INSXR,3(RA) ;FOSCIL=SLIGHTLY FASTER OSCIL
KAFIX INSXR,233000 >
IFN KI10SW,<
↑FOSCIL:KIFIX INSXR,3(RA) >
TRZE INSXR,777000
JSP T1,FSCIL1
;; JRST FSCIL1
MOVE T,@2(RA)
FMPR T,@(RA)
MOVE T1,@1(RA) ;FOSCIL HAS NO CHECK FOR NEG. INC.!!!!!!!
FADM T1,3(RA)
JRST 4(RA)
FSCIL1↑:MOVSI (-512.0) ;WRAP AROUND THE POINTER.
FADM 3(RA)
JRST (T1)
;; JRST FOSCIL
↑OUT: 0 ;FUNCTION OUT(VALUE); BEGIN OUTA←OUTA+VALUE; END
MOVE @(RA) ;PICK UP INPUT.
FADM OUTA ;ACCUMULATE INTO OUTPUT ARRAY.
POPJ P, ;RETURN FROM INSTRUMENT.
↑OUT2: 0 ;FUNCTION OUT(X,CH1,CH2);
MOVE @(RA) ; BEGIN OUTA←OUTA+X*CH1; OUTB←OUTB+X*CH2; END
MOVE 1,0
FMP 0,@1(RA)
FADM 0,OUTA ;
FMP 1,@2(RA)
FADM 1,OUTB
POPJ P,
↑EXPEN: MOVE INSXR,@1(RA) ;GET INCREMENT.
FADB INSXR,3(RA) ;INCREMENT POINTER.
IFE KI10SW,< KAFIX INSXR,233000 >
IFN KI10SW,< KIFIX INSXR,INSXR >
CAIL INSXR,777 ;IF GREATER THAN 511, STICK
EXPEN2: MOVEI INSXR,777 ;AT LAST ELEMENT OF ARRAY. (ALSO COMES HERE FROM ZEXPEN)
MOVE T,@2(RA) ;GET ARRAY ELEMENT.
FMPR T,@(RA) ;MULTIPLY BY AMPLITUDE.
JRST 4(RA) ;RETURN.
COMMENT ⊗
CALLED WITH:
JSP RA,VFMULT
<Amplitude> ;0
<Position> ;1
<Array>(INSXR) ;2
⊗;
VFM2: FSBR INSXR,[512.0] ;YOU MUST NOW SET PTR FOR VFMULT!
MOVEM INSXR,@VFMULT
↑VFMULT: MOVE INSXR,@1(RA) ;GET POINTER INPUT.
CAML INSXR,[512.0]
JRST VFM2
IFE KI10SW,< KAFIX INSXR,233000 >
IFN KI10SW,< KIFIX INSXR,INSXR >
MOVE T,@2(RA) ;GET INDICATED ELEMENT OF ARRAY.
FMPR T,@(RA) ;MULT. BY AMPLITUDE.
JRST 3(RA)
COMMENT ⊗ NOSCA
JSP RA,NOSCA
<Initial sum> ;-1(-6)
<Ampiltude> ;0 (-5)
<Increment> ;1 (-4)
<Array>(INSXR) ;2 (-3)
<Temp - Sum> ;3 (-2)
⊗;
↑INOSCA: 0
MOVE T,(RA)
MOVE T1,@-6(T)
MOVEM T1,-2(T)
JRA RA,1(RA)
COMMENT ⊗ INTRP
JSP RA,INTRP
<Value 1> ;-1(-6)
<Value 2> ;0 (-5)
<Temp - Increment> ;1 (-4)
<Array>(INSXR) ;2 (-3)
<Temp - sum> ;3 (-2)
⊗;
↑INTRP: ADDI RA,1 ;TO KEEP OSCIL1 HAPPY (CHANGE THIS SOMEDAY)
IFE KI10SW,<
MOVE INSXR,3(RA) ;GET INDEX IN ARRAY
KAFIX INSXR,233000 >
IFN KI10SW,< KIFIX INSXR,3(RA) > ;MAKE AN INTEGER
TRZE INSXR,777000 ;DID IT WRAP AROUND?
JSP T1,OSCIL1 ;YES, BUT IT REALLY SHOULDN'T!!!!
MOVE T,@2(RA) ;GET ARRAY ELEMENT
MOVE @(RA) ;GET FIRST VALUE
FSBR @-1(RA) ;SUBTRACT THE SECOND
FMPR T,0 ;MULIPLY ARRAY ELEMENT BY DIFFERENCE
FADR T,@-1(RA) ;AND ADD THE FIRST VALUE
MOVE T1,1(RA) ;NOW UPDATE THE SUM
FADM T1,3(RA)
JRST 4(RA)
↑IINTRP: 0
MOVE T,(RA) ;GET INDEX TO ARGUMENT LIST
MOVSI T1,(512.0) ;NOW CALCULATE THE INCREMENT BASED ON THE
FDVR T1,SRATE ;DURATION OF THE NOTE
FDVR T1,PBASE+2
MOVEM T1,-4(T) ;SAVE IN ANOTHER TEMP
JRA RA,1(RA)
; ZOSCIL Family of Unit Generators
COMMENT ⊗ ZOSCIL - Called with
JSP RA,ZOSCIL
<Amplitude> ;0
<Increment> ;1
<Array> ;2
<Zeroed-Sum> ;3
⊗;
↑ZOSCA: ADDI RA,1
IFE KI10SW,<
↑ZOSCIL: MOVE INSXR,3(RA) ;ZOSCIL WORKS LIKE COSCIL AND NOSCIL!
KAFIX INSXR,233000 >
IFN KI10SW,<
↑ZOSCIL:KIFIX INSXR,3(RA) > ;MAKE AN INTEGER
TRZE INSXR,777000 ;DID WE RUN OVER?
JSP T1,ZOSCL1 ;YES, DO WRAPAROUND
MOVE T,@2(RA) ;PICK UP FIRST ELEMENT
move insxr ;SAVE INDEX
move t1,t ;COPY FIRST ELEMENT
cain insxr,777 ;ARE WE AT THE LAST ELEMENT
tdza insxr,insxr ;YES, SET INDEX TO ZERO AND SKIP
addi insxr,1 ;NO, INCREMENT INDEX
fsbr t1,@2(ra) ;GET DWFFERENCE IN VALUE I
fsc 233 ;(FLOAT THE INDEX)
fsb 3(ra) ;GET DIFFERENCE IN INDEX INTO 0
fmpr t1,0 ;THE PRODUCT OF THE ABOVE TWO DIFFERENCES
fadr t,t1 ;IS ADDED TO THE FIRST ELEMENT
FMPR T,@(RA) ;SCALED BY AMPLITUDE
MOVE T1,@1(RA) ;UPDATE SUM OF INCREMENTS
FADM T1,3(RA)
JRST 4(RA)
ZOSCL1: MOVSI (-512.0) ;WRAP AROUND THE POINTER.
JUMPGE INSXR,.+2
MOVNS 0 ;IF NEG. INC., WRAP AROUND OTHER WAY.
FADB 0,3(RA) ;Update pointer
IFE KI10SW,< MOVE INSXR,0
KAFIX INSXR,233000 >
IFN KI10SW,< KIFIX INSXR,0 > ;Fix it again and check range
TRZN INSXR,777000 ;Better be between 0 and 511
JRST (T1)
JRST ZOSCL1 ;Still out of range, try again
↑ZEXPEN: SKIPGE INSXR,3(RA) ;ZEXPEN WORKS LIKE ZOSCIL AND EXPEN!
JRST [ WARN (Negative increment to ZEXPEN)
COMMENT ⊗ ZEXPEN is undefined for negative increments however if you contiune
it will treat it like a ZOSCIL.⊗;
JSP T1,OSCIL1 ;DO WRAPAROUND ANYWAY
JRST .+1] ;LET THE LOSER CONTINUE
IFE KI10SW,< KAFIX INSXR,233000 >
IFN KI10SW,< KIFIX INSXR,INSXR >
CAIL INSXR,777 ;IF GREATER THAN 511, STICK
JRST EXPEN2 ;AT LAST ELEMENT (WE WON'T NEED TO INTERPOLATE)
MOVE T,@2(RA) ;PICK UP FIRST ELEMENT
move insxr ;SAVE INDEX
move t1,t ;COPY FIRST ELEMENT
addi insxr,1 ;NO, INCREMENT INDEX
fsbr t1,@2(ra) ;GET DWFFERENCE IN VALUE I
fsc 233 ;(FLOAT THE INDEX)
fsb 3(ra) ;GET DIFFERENCE IN INDEX INTO 0
fmpr t1,0 ;THE PRODUCT OF THE ABOVE TWO DIFFERENCES
fadr t,t1 ;IS ADDED TO THE FIRST ELEMENT
FMPR T,@(RA) ;SCALED BY AMPLITUDE
MOVE T1,@1(RA) ;UPDATE SUM OF INCREMENTS
FADM T1,3(RA)
JRST 4(RA)
COMMENT ⊗ ZINTRP
JSP RA,ZINTRP
<Value 1> ;-1(-6)
<Value 2> ;0 (-5)
<Temp - Increment> ;1 (-4)
<array>(INSXR) ;2 (-3)
<Temp - sum> ;3 (-2)
⊗;
↑ZINTRP: ADDI RA,1 ;AN INTERPOLATING INTRP!
IFE KI10SW,<
MOVE INSXR,3(RA)
KAFIX INSXR,233000 >
IFN KI10SW,< KIFIX INSXR,3(RA) >
TRZE INSXR,777000 ;DID WE RUN OVER?
JSP T1,ZOSCL1 ;YES, DO WRAPAROUND (BUT IT REALLY SHOULDN'T!)
MOVE T,@2(RA) ;PICK UP FIRST ELEMENT
move insxr ;SAVE INDEX
move t1,t ;COPY FIRST ELEMENT
cain insxr,777 ;ARE WE AT THE LAST ELEMENT
tdza insxr,insxr ;YES, SET INDEX TO ZERO AND SKIP
addi insxr,1 ;NO, INCREMENT INDEX
fsbr t1,@2(ra) ;GET DIFFERENCE IN VALUE I
fsc 233 ;(FLOAT THE INDEX)
fsb 3(ra) ;GET DIFFERENCE IN INDEX INTO 0
fmpr t1,0 ;THE PRODUCT OF THE ABOVE TWO DIFFERENCES
fadr t,t1 ;IS ADDED TO THE FIRST ELEMENT
MOVE @(RA) ;GET SECOND VALUE
FSBR @-1(RA) ;SUBTRACT THE FIRST
FMPR T,0 ;MULIPLY BY DIFFENCE BETWEEN TWO VALUES
FADR T,@-1(RA) ;AND ADD TO THE FIRST VALUE
MOVE T1,1(RA) ;UPDATE SUM OF INCREMENTS
FADM T1,3(RA)
JRST 4(RA)
; More generators, LINEN
COMMENT ⊗ Called with:
JSP RA,LINEN
<Temp - Increment for attack> ;0 (-14)
<Temp - Incrememt for middle> ;1 (-13)
<Temp - Increment for decay> ;2 (-12)
<Amplitude> ;3 (-11)
<Attack time in seconds> ;4 (-10)
<decay time in seconds> ;5 (-7)
<Duration in seconds> ;6 (-6)
<Array>(INSXR) ;7 (-5)
<Sum of increments (not temp)> ;10 (-4)
<Zeroed - Current increment > ;11 (-3)
<Zeroed - End of section of array>;12(-2)
⊗;
↑LINEN: MOVE INSXR,11(RA) ;GET INCREMENT.
; FADB INSXR,10(RA) ;ADD TO POINTER.
JUMPL INSXR,[ WARN (Negative increment to LINEN)
COMMENT ⊗ LINEN is undefined for negative increments. The results may be
unpredicatable. Probably means that the attack time plus the decay time
exceeds the duration. ⊗;
JRST LINEN4-1]
FADB INSXR,@10(RA) ;NOW YOU MUST RESET PTR
LINEN4: CAML INSXR,12(RA) ;ARE WE PAST END OF SECTION ?
JRST LINEN2 ;YES.
IFE KI10SW,< KAFIX INSXR,233000 >
IFN KI10SW,< KIFIX INSXR,INSXR >
MOVE T,@3(RA) ;AMPLITUDE.
FMPR T,@7(RA) ;MULT. BY ARRAY ELEMENT.
JRST 13(RA) ;RETURN.
LINEN2: MOVE T,12(RA) ;PICK UP CURRENT LIMIT.
FDVRI T,(<128.0>)
IFE KI10SW,< KAFIX T,233000 >
IFN KI10SW,< KIFIX T,T >
CAIL T,3 ;END OF ARRAY ?
JRST LINEN3 ;YES.
HRLI T,RA ;PREPARE FOR INDEXING...
MOVE @T ;PICK UP NEXT INCREMENT.
MOVEM 11(RA) ;PUT AWAY.
MOVSI (128.0)
FADM 12(RA) ;INCREMENT LIMIT TO NEXT VALUE.
JRST LINEN4
LINEN3: MOVEI 14(RA) ;FAKE UP A PARAMETER FOR LINEN1.
MOVEM .+2
JSA RA,LINEN1 ;RE-INITIALIZE THE GENERATOR.
0 ;
; SETZM 10(RA) ;RESET PTR.
SETZM @10(RA) ;NOW YOU MUST RESET PTR
SETZM 11(RA) ;AND INCREMENT.
SETZM 12(RA) ;...AND LIMIT.
JRST LINEN
↑LINEN1: 0 ;THE INITIALIZING CODE FOR LINEN.
MOVE T2,(RA) ;GET POINTER TO END OF PARAMETERS.
MOVE T1,[1.0] ;CALC. 128*(SECONDS/SAMPLE)
FDVR T1,SRATE
FSC T1,7
MOVE T,@-10(T2) ;GET RISE TIME IN SECONDS.
FDVRM T1,T ;INCREMENT←T1/TIME (=128/(TIME IN SAMPS))
MOVEM T,-14(T2) ;PLACE IN PARAMETER 0.
MOVE T,@-6(T2) ;DURATION OF NOTE IN SECONDS...
FSBR T,@-7(T2) ;...MINUS FALL TIME..
FSBR T,@-10(T2) ;...MINUS RISE TIME.
FDVRM T1,T ;CHANGE TO INCREMENT.
MOVEM T,-13(T2) ;PLACE IN PARAMETER 1.
FDVR T1,@-7(T2) ;INCREMENT FOR FALL TIME.
MOVEM T1,-12(T2) ;PLACE IN PARAMETER 2.
JRA RA,1(RA)
↑VALUE: MOVE T,@(RA) ;DUMMY UNIT GENERATOR... OUTPUT IS
JRST 1(RA) ;SAME AS ITS PARAMETER.
; Reverberation Unit Generators
; REV1 IS THE SIMPLE FED-BACK DELAY LOOP, OR 'COMB FILTER'.
COMMENT ⊗ Called with:
JSP RA,REV1
<Input to reverberator> ;0 (-7)
<Delay length> ;1 (-6)
<Gain> ;2 (-5)
<Array>(INSXR) ;3 (-4)
<Temporary - Array pointer> ;4 (-3)
<Temp. - Int. Length of array> ;5 (-2)
⊗;
↑REV1: AOS INSXR,4(RA) ;INCREMENT OUTPUT PTR.
CAML INSXR,5(RA) ;IS IT TIME TO WRAP AROUND ?
SETZB INSXR,4(RA) ;YES.
MOVE 1,@3(RA) ;GET OUTPUT OF DELAY LINE.
MOVE 2,1 ;LEAVE IN 1 AS FINAL OUTPUT.
FMPR 2,@2(RA) ;MULTIPLY BY FEEDBACK GAIN.
IFE KI10SW,<
REVA: MOVE @1(RA) ;GET DELAY TIME, T.
KAFIX 0,233000 >
IFN KI10SW,<
REVA: KIFIX 0,@1(RA) >
ADD INSXR,0 ;MOVE PTR. AROUND TO INPUT END.
CAML INSXR,5(RA) ;PROBABLY HAVE TO WRAP AROUND..
SUB INSXR,5(RA) ;YUP. SUBTRACT LENGTH OF DELAY ARRAY.
FADR 2,@(RA) ;ADD IN THE INPUT SAMPLE.
JFCL 1,[SETZB 2,1 ;FLOAT. UNDER FLOW
SETOM FXUFLG#
JRST .+1]
MOVEM 2,@3(RA) ;PLACE IN INPUT OF DELAY LINE.
JRST 6(RA) ;RETURN.
;REV2 IS THE ALL-PASS REVERBERATOR.
COMMENT ⊗ Called with:
JSP RA,REV2
<Input to reverberator> ;0 (-7)
<Delay length> ;1 (-6)
<Gain> ;2 (-5)
<Array>(INSXR) ;3 (-4)
<Temporary - Array pointer> ;4 (-3)
<Temp. - Integer form of 1(RA)> ;5 (-2)
⊗;
↑REV2: AOS INSXR,4(RA) ;CALC. PTR. AS IN REV1.
CAML INSXR,5(RA)
SETZB INSXR,4(RA)
repeat 0,< ; Comment out to make way for new reverberator
MOVN 1,@3(RA) ;GET NEGATIVE OF OUTPUT OF DELAY.
MOVN 0,@2(RA) ;ALSO NEGATIVE OF GAIN, G.
FMPR 1,0 ;FORM GAIN*OUTPUT
MOVE 2,1 ;(NOTE THIS IS POSITIVE).
FMPR 1,0 ;FORM -G↑2 * OUTPUT.
FADR 1,@3(RA) ;(1-G↑2) * OUTPUT.
FMPR 0,@(RA) ;FORM -G * INPUT.
FADR 1,0 ;FINAL OUTPUT IS -G*IN +(1-G↑2)*OUT.
> ; Ends repeat 0 above (JAM 10/28/75)
COMMENT ⊗ ; KS 13-May-1977 substitute lattice form, eliminate a multiply!
MOVN 1,@2(RA) ; PICK UP NEGATIVE OF GAIN, G.
FMPR 1,@(RA) ; ACCUMULATE -G*INPUT
MOVE 2,@3(RA) ; PICK UP OUTPUT OF DELAY
FADRB 1,2 ; TOTAL OUTPUT IS OUT-G*INPUT
FMPR 2,@2(RA) ; FEED G*TOTAL OUTPUT BACK INTO DELAY
⊗ ; KS -- End of JAM's substitution, start of mine
MOVN 2,@(RA) ; PICK UP NEGATED INPUT
FADR 2,@3(RA) ; ADD IN DELAYED SIGNAL
FMPR 2,@2(RA) ; MULTIPLY IN GAIN
MOVE 1,@3(RA) ; GET DELAYED SIGNAL AGAIN
FADR 1,2 ; COMBINE WITH ATTENUATED (INPUT+DELAYED SIGNAL)
; KS -- End of my substitution
JRST REVA ;FROM HERE ON, SAME AS REV1.
; THIS IS THE I-TIME CODE FOR DELAY, REV1 AND REV2.
↑REVI: HRRZ T1,(RA) ;GET PTR. TO END OF REV PARAMS.
MOVNI INSXR,1 ;INSXR←-1
HRRZ @-4(T1) ;GET -1ST ELEMENT OF ARRAY (THE LENGTH)
MOVEM -2(T1) ;PLACE IN THE SECOND DUMMY PARAM.
IFE KI10SW,<
MOVE T,@-6(T1) ;CHECK FOR ILL ARRAY REF.
KAFIX T,233000 >
IFN KI10SW,< KIFIX T,@-6(T1) >
CAMGE 0,T
JRST [ MOVNI INSXR,3 ;INSXR←-3
MOVE @-4(T1)
PUSHJ P,ILLARF ;OOPS!
JUMP T,@0
JRST .+1 ]
SKIPN REVINI ;SHOULD WE INIT. THE DELAY ARRAY ?
JRST 1(RA) ;NO.
SETZM -3(T1) ;YES. FIRST CLEAR THE POINTER LOC.
HRRZ T,-4(T1) ;GET PTR. TO ARRAY.
↑REVI2: ADDI -1(T) ; 0 NOW POINTS TO TOP OF ARRAY.
HRL T,T
SETZM (T) ;CLEAR FIRST ELEMENT OF ARRAY.
ADDI T,1 ;FORM BLT POINTER.
BLT T,@0 ;CLEAR REST OF ARRAY.
JRST 1(RA)
; DELAY IS THE SIMPLE DELAY
COMMENT ⊗ Called with:
JSP RA,DELAY
<Input to reverberator> ;0 (-7)
<Delay length> ;1 (-6)
<Temporary - for compatability> ;2 (-5)
<Array>(INSXR) ;3 (-4)
<Temporary - Array pointer> ;4 (-3)
<Temp. - Integer form of 1(RA)> ;5 (-2)
⊗;
↑DELAY: AOS INSXR,4(RA) ;INCREMENT OUTPUT PTR.
CAML INSXR,5(RA) ;IS IT TIME TO WRAP AROUND ?
SETZB INSXR,4(RA) ;YES.
MOVE 1,@3(RA) ;GET OUTPUT OF DELAY LINE.
IFE KI10SW,<
MOVE 0,@1(RA) ;GET DELAY TIME, T.
KAFIX 0,233000 >
IFN KI10SW,< KIFIX 0,@1(RA) >
ADD INSXR,0 ;MOVE PTR. AROUND TO INPUT END.
CAML INSXR,5(RA) ;PROBABLY HAVE TO WRAP AROUND..
SUB INSXR,5(RA) ;YUP. SUBTRACT LENGTH OF DELAY ARRAY.
MOVE 2,@(RA) ;GET INPUT SAMPLE.
MOVEM 2,@3(RA) ;PLACE IN INPUT OF DELAY LINE.
JRST 6(RA) ;RETURN.
SUBTTL Random Numbers
;; RANDOM NUMBER GENERATORS.
COMMENT ⊗
CALLED WITH:
JSP RA,RANDH
<Scale factor> ;0 (-5)
<Increment> ;1 (-4)
<Temp - Sum> ;2 (-3) Gets new random number
<Temp - Random number> ;3 (-2) upon wraparound
⊗;
↑RANDH: MOVE @1(RA) ;GET INCREMENT.
FADB 2(RA) ;INCREMENT THE 'POINTER'.
CAML [512.0] ;OVER 512 ?
JRST RNDH2 ;YES. GO GET NEW RANDOM NUMBER.
MOVE T,@(RA) ;NO. GET INPUT ...
FMPR T,3(RA) ;... AND MULT. BY CURRENT RANDOM NO.
JRST 4(RA) ;RETURN.
RNDH2: MOVSI (-512.0) ;CAUSE 'POINTER' TO 'WRAP AROUND'.
FADM 2(RA)
PUSHJ P,RAND ;GET NEW RANDOM NO.
MOVEM T,3(RA) ;MAKE IT THE CURRENT NO.
FMPR T,@(RA) ;MULT. BY INPUT.
JRST 4(RA) ;RETURN.
↑IRANDI: ;I-TIME CODE FOR RANDI AND RANDH.
↑IRANDH: PUSHJ P,RAND ;INIT. RANDH.
MOVE T2,(RA) ;GET PTR. TO LAST PARAM..
MOVEM T,-2(T2) ;PUT INITIAL RAND. NO. IN.
JRST 1(RA)
↑RANDI: MOVE T,2(RA) ;GET CURRENT DELTA..
FADRB T,4(RA) ;ADD TO LAST OUTPUT VALUE...
SOSG 3(RA) ;DECREMENT STEP COUNTER ...
JRST RNDI2 ;IT'S 0, SO GET NEW RANDOM NO.
FMPR T,@(RA) ;NO. MULT BY INPUT.
JRST 5(RA) ;RETURN.
RNDI2: PUSHJ P,RAND ;GET NEXT RANDOM NO.
FSBR T,4(RA) ;FORM DELTA (=NEW - OLD)
MOVSI T1,(512.0)
FDVR T1,@1(RA) ;NO. OF STEPS = 512/(FREQ. INPUT)
FDVR T,T1 ;CHANGE PER STEP =DELTA/NO. OF STEPS
MOVEM T,2(RA) ;STORE CHANGE PER STEP.
IFE KI10SW,< KAFIX T1,233000 >
IFN KI10SW,< KIFIX T1,T1 >
MOVEM T1,3(RA) ;PUT IT AWAY.
JRST RANDI ;NOW GO GENERATE FIRST STEP.
BEND U.G.
IFN 0,< ; JAM 11/12/75 - MAKE THIS THING HONEST!!!
RAND: MOVE T,RNDNO1 ;GENERATE A RANDOM NO.
ADD T,RNDNO2 ;How dare you call this a random number
EXCH T,RNDNO2 ;generator!!!
MOVEM T,RNDNO1
ASH T,-10 ;SMEAR SIGN INTO EXPONENT FIELD..
FSC T,200 ;... AND FLOAT IT IN RANGE -1 TO 1.
POPJ P,
RNDNO1: 756132257563
RNDNO2: 756132257565
>; IFN 0,JAM 11/12/75 - MATCHES IFN 0 ABOVE
; LINEAR CONGRUENTIAL RANDOM NUMBER GENERATOR
RAND: SKIPE T,SEED ; PICK UP LAST NUMBER
JRST RAND1 ; ALREADY INITIALIZED
RUNTIM T, ; NEED NEW SEED, GET IT FROM DATE AND TIME
ROT T,=12 ; SCRAMBLE THESE NUMBERS GOOD
MSTIME T1,
XOR T,T1
ROT T,=12 ; INVERT THE SIGNIFICANCE OF THE BITS
DATE T1,
XOR T,T1
RAND1: IMUL T,[267455123765]
MOVS T,T
MOVEM T,SEED
ASH T,-10 ;SMEAR SIGN INTO EXPONENT FIELD..
FSC T,200 ;... AND FLOAT IT IN RANGE -1 TO 1.
POPJ P,
SEED: 0 ; LAST RANDOM NUMBER GENERATED
SUBTTL FORTRASH Routines and Random Functions
INTERNAL RDNUM,PNUM,SBFILN,SBDEVN,ARRLEN
;INTERNAL RDNUM,MESS,PNUM,QTTYIN,SBFILN,SBDEVN
INTERNAL INFIL2,INFIL3,INFIL4,INFILE
;SBFILN=FILE NAME FOR PLAY PROG. SBDEVN=DEVICE NAME
EXTERNAL JOBDDT;
FOOPRT: 0
JRST PNUM2
PNUM: 0
; MOVE P,JOBFF ;$%%##$$##
MOVE P,[IOWD LOSTK,OSTK] ;THAT'S BETTER!
PNUM2: JSR SAVE
MOVE A,@(RA)
PUSHJ P,OUTFLT
JSR RESTORE
JRA RA,1(RA)
RDNUM: 0 ;NUMBER READER FOR FOOTRAN ROUTINES.
; MOVE P,JOBFF ;GET TEMP. PDL *****
MOVEM P,RDNUMP#
MOVE P,[IOWD LOSTK,OSTK] ;THAT'S BETTER!
EXCH FL,FLSV1
RDNUM1: TLO FL,SNUMF1+NOSTAR ;INHIBIT PROMPT!
PUSHJ P,SCAN
CAMN A,MINV ;A MINUS SIGN ?
TLOA FL,MINFLG ;YES. SET FLAG AND LOOP BACK.
TLNN A,NUMFLG ;IT IS A NUMBER, ISN'T IT ?
JRST RDNUM1 ;NO. IGNORE IT.
TLZE FL,MINFLG ;YES. HAVE WE SEEN A MINUS LATELY ?
MOVNS C ;YES.
MOVEM C,@(RA) ;PUT VALUE INTO PARAMETER.
TLZ FL,NOSTAR
EXCH FL,FLSV1
MOVE P,RDNUMP
JRA RA,1(RA) ;RETURN TO (UGH ! BLETCH !) FOOTRAN.
INT: 0 ;INTEGER PART
;Cretinous KI10 does a FORTRAN FIX, not the Entier function!
;So, we get to do the floor function the hard way!
IFE KI10SW,< MOVE 0,@(RA)
KAFIX 0,233000 >
IFN KI10SW,< KIFIX 0,@(RA) >;Use KI10 fix instruction in to do hard stuff
FSC 0,233
SKIPGE @(RA) ;Argument negative?
CAMN 0,@(RA) ; And was not already an integer
JRA RA,1(RA) ; No, return FIX(X)
FSBRI 0,(<1.0>) ;Yes, then KIFIX is off by one for
JRA RA,1(RA) ;Entier function
; STRLEN
ARRLEN: 0 ;Returns length of array
HRRZ 1,(RA)
MOVE 1,-1(1)
FSC 1,233
JRA RA,1(RA) ;RETURNS LENGTH IN AC1
STRLEN: 0 ;Returns length of string
MOVEM 2,SAVE2#
HRRZ 2,(RA)
HRLI 2,440700
SETZ 1,
ILDB 0,2
JUMPE 0,[ MOVE 2,SAVE2#
FSC 1,233
JRA RA,1(RA) ]
AOJA 1,.-2
;ARRBLT(TO,FROM,COUNT)
ARRBLT:0
HRRZ 0,(RA)
HRL 0,1(RA)
HRRE 1,@2(RA)
ADD 1,(RA)
BLT 0,-1(1)
JRA RA,3(RA)
SUBTTL Extended Commands
;(PRECEDED BY <ALT MODE> OR ⊗)
COMMND:
SETO 1,
TTYUUO 6,1
TLNN 1,420000 ;SKIP IF NOT AT DD OR III
OUTSTR [ASCII /$/]
PUSHJ P,SCANNS ;GET COMMAND.
CAMN A,EXITV ;AN EXIT?
EXIT
CAME A,LISTV
TLNE A,DECLBIT
JRST CMDLST ;A LIST STATEMENT
JUMPL A,[COMND1: OUTSTR [ASCIZ /UNKNOWN COMMAND?? /]
JRST SCHOWN]
MOVE ACCUM
MOVE 1,ACCUM+1
LSHC 6
SETZ B,
COMND2: SKIPN CMDTAB(B)
JRST COMND1
CAME CMDTAB(B)
AOJA B,COMND2
JRST @CMDTA2(B)
CMDTAB: ;TABLE OF EXTENDED COMMANDS
SIXBIT/EXCISE/
SIXBIT/FREEZE/
SIXBIT/P/
0
CMDTA2:
EXCISE
FREEZ1
CPLAY
CPLAY: SKIPN MTA ;******DON'T PLAY, USING MAGTAPE*************
PUSHJ P,PLAY↑
JRST SCHOWN
; More Command Routines.
EXCISE:
MOVE JOBFF
CORE
SYSERR<Can't reduce core!>
COMMENT ⊗ Shouldn't happen. ⊗;
MOVE JOBREL
MOVEM BEGFRE ;UPDATE FREE STORAGE POINTER
JRST SCHOWN
FREEZ1:
SETOM ONCEFG ;TURN ON HELP MESSAGE, ETC.
MOVE A,[XWD BUCTBL,SVAREA]
BLT A,2*SVAREA-BUCTBL-1 ;SAVE SYMBOL TABLE POINTERS
MOVE JOBFF ;SAVE JOBFF
MOVEM OLDJFF
CORE
SYSERR <Can't reduce core!>
COMMENT ⊗ Shouldn't happen. ⊗;
OUTSTR [ASCIZ/FROZEN!/]
EXIT 1,
JRST GO
; This handy routine tells you what's in the symbol table
;THE COMMAND FORM
CMDLST: PUSH P,[[PUSHJ P,SCAN ;EAT THE OPTIONAL 'LIST'
CAME A,LISTV
JRST CHOWN
JRST SCHOWN]]
LSTSYM: MOVE B,[XWD -(LSTEND-LSTTAB)-1,LSTTAB-1]
AOBJP B,CPOPJ ;SEARCH FOR TYPE DECLARATION FAILED
CAME A,@(B) ;THIS TYPE?
JRST .-2 ;NO, TRY NEXT
HLRZ C,(B) ;GET RANDOM GOOD BIT
MOVE D,[XWD -BUCKNO-1,BUCTBL-1] ;SEARCH EACH BUCKET
AOBJP D,CPOPJ ;LAST ONE?
MOVE B,(D) ;GET BEGINNING OF BUCKET
LSTLOOP:CAIN B,A-1 ;AT END?
JRST .-3 ;YES
MOVE A,2(B) ;FOR PRNTSYM
TLNE A,(C) ;RIGHT RANDOM GOOD BIT ON?
JRST [ MOVEI A,2(B) ;FOR PRNTSYM
PUSHJ P,PRNTSYM ;YES, PRINT SYMBOL NAME
OUTSTR[ASCIZ/ /]
JRST LSTLO1]
LSTLO1: MOVE B,(B) ;GET NEXT ONE ON LIST
JRST LSTLOOP
LSTTAB: XWD VRBLBT,VARV
XWD ARRYBT,ARRV
XWD INSBIT,INSV
XWD FUNBIT,FUNV
XWD UGBIT,UGV
XWD 777740,LISTV
LSTEND←←.
;ROUTINE CALLABLE FROM DDT
LISTSY: JSR SAVE ;SAVE AC'S
EXCH H,SNCHR ;SAVE SNCHR
OUTSTR[ASCIZ/
FOR:/]
PUSHJ P,SCANNS
PUSHJ P,LSTSYM
EXCH H,SNCHR ;RESTORE SNCHR
JSR RESTORE
POPJ P,
SUBTTL SMPOUT - Sample Output Buffer Routines
;THIS IS THE NEW MAGIC SAMPLE BUFFER ROUTINES, WATCH THEM HANDLE
;THE DISK, THE UDP AND THE DAC, ALL IN ONE PROGRAM!!!
BEGIN SMPOUT
DBLKSZ←←200 ;SIZE OF A DISK BLOCK
DBFNUM←←=10 ;NUMBER OF BUFFERS (SHOULD BE SOME FACTOR OF 18, PLUS 2)
;BUFFERING
SBDNUM←←=11*=18 ;NUMBER OF BLOCKS IN A SAMPLE FILE (SHOULD BE MULTIPLE
;THE RECORDS/TRACK FOR DISK
SBUNUM←←10 ;NUMBER OF BLOCKS BETWEEN SAVES (MUST BE POWER OF 2)
TODSK←←2
DEVIOS←←2 ;OFFSET TO I/O STATUS WORD IN DDB
IOSYNC←←40 ;ONE BUFFER AT A TIME, PLEASE (SYMBOL: 'IOSYNC` INVENTED)
↑PLINIT:SETZM BLKNUM ;CLEAR BLOCK COUNT
SETZM SAVDON ;CLEAR .SAV WRITTEN FLAG
SETZM QUIET# ;SUPPRESS STATS AND FILE INC.
SETZM SBWC ;CLEAR WORD COUNT
SETZM RUFLAG ;CLEAR 'RUN .SAV` FLAG
MOVEI A,1
MOVEM A,SBUSET ;Reset USETO pointer
OUTPUT TTY, ;FLUSH THE TTY BUFFER, WE'RE TTYUUOING AROUND
;HERE
LDB A,SCP ;Check for PLAY <file spec>
CAIN A," "
JRST [ MOVE A,[PUSHJ P,SCNGET]
JRST PNOASK ]
MOVSI A,(<POINT 7,0>) ;Make string pointer to default output
HRR A,OUTFIL ;specification.
MOVEM A,SPCPTR#
MOVE A,[ILDB 1,SPCPTR]
SKIPN @OUTFIL ;Make sure there is something there
PLOOP1: MOVE A,[INCHWL 1] ;CHARACTER STREAM
PNOASK: MOVEM A,PLAYOP#
SETZM BYTSIZ
CAMN A,[INCHWL 1]
OUTSTR [ASCIZ/
Output: /]
PUSH P,[SBDEVC+1]
PUSH P,PLAYOP
PUSH P,[0]
PUSHJ P,RDIOSP
JFCL
PUSHJ P,IGNOLF
SETZ A,
SKIPN SBFILN+1 ;DOES FILE HAVE AN EXTENSION
JRST [ SKIPN SBFILN ;NO, A FILE NAME?
JRST INIDSK ; GO INIT DSK
TYPSTR [ASCIZ/Please include an extension or ':'
/]
JRST PLINIT]
SKIPN SBFILN
JRST [ TYPSTR [ASCIZ/You need a file name.
/]
JRST PLOOP1]
JRST INIDSK ;***** NEW OCT 9,77
PLINI2: MOVEM F,PLYOPT ;SAVE PLAY OPTION NUMBER
MOVE SIZ,SSIZES(F) ;GET BUFFER SIZE
;;; MOVEM SIZ,LSBUF#;SAVE BUFFER SIZE
PLINLO: MOVE T,BEGFREE ; FIGURE OUT HOW MUCH SPACE WE HAVE
SUB T,JOBFF
SUBI T,4*LOBUFS
CAMGE T,SIZ
COREFULL ;GET SOME CORE WHILE WE CAN
JRST PLINLO ;TRY AGAIN
MOVN T,SIZ
PUSHJ P,GFS ;CALL FREE STORAGE ROUTINE
MOVE THIS,T
MOVEM THIS,SBBOTT;SAVE ADDRESS OF BUFFER
REINIT: MOVE THIS,SBBOTT
HLL THIS,SBPTRS(F) ;GET APPROPRIATE BYTE POINTER
MOVEM THIS,SBPTR ;SET UP BYTE POINTER FOR SAMPLES
IFE KI10SW,< MOVE 0,BITS
KAFIX 0,233000 >
IFN KI10SW,< KIFIX 0,BITS >; BITS SETS THE BYTESIZE ********
MOVEM BYTSIZ#
MOVE SAVCNT ;HAS IT BEEN FIXED YET?
TLNE -1 ;IS IT FLOATING ?
IFE KI10SW,< KAFIX 0,233000 >
IFN KI10SW,< KIFIX 0,0 >
MOVEM SAVCNT ; SAVCNT SETS THE SAVE RECORD NUM.****
;; KIFIX SAVIT
;; MOVEM SAVCNT
SKIPE SIZ,BYTSIZ ;NON-STANDARD BYTE SIZE?
DPB SIZ,[POINT 6,SBPTR,11]
LDB SIZ,[POINT 6,SBPTR,11]
MOVEI THIS,=36
IDIV THIS,SIZ
MOVEM THIS,NBYTES
IMUL THIS,SSIZES(F)
;;; IMUL THIS,LSBUF
MOVEM THIS,SBCNT
POPJ P,
↑ANSWER:INCHWL
CAIN 12 ;IN CASE THERE WAS A <LF> IN THE TTY BUFFER
JRST ANSWER
CAIE "y" ;EAT LOWER CASE, TOO
CAIN "Y" ;IF "Y" THEN SKIP
AOS (P)
CAIN 12 ;END OF LINE?
POPJ P, ;YES
INCHWL ;NO, GET ANOTHER AND TRY AGAIN
JRST .-3
;EXTERNAL JOBJDA
MAKBUF: MOVE SBBOTT ;GET ADDRESS OF BUFFER
PUSH P,SBPTR
EXCH JOBFF
OUTBUF SBCHAN,@BUFNUM(F)
EXCH JOBFF
POP P,0
TLZ 0,770000
HLLM 0,SBPTR
POPJ P, ;NOW, RETURN
ERROR <ERROR IN SETTING UP BUFFER RINGS>
; Initialize DSK or UDP for output;
INIDSK: SKIPN SBFILN
JRST [ OUTSTR [ASCIZ/Illegal file name
/]
JRST PLINIT]
SETZ B,
;INIDS3:
INIDS4: SETZM SBDEVC ;SET BUFFERED MODE
SETZM TIME
MOVSI SBHDR
MOVEM SBDEVC+2
OPEN SBCHAN,SBDEVC
SYSERR<Can't INIT DEVICE!> ;An unlikely situation. ⊗;
;**********************MAGTAPE****************************
;** TO USE TAPE - OUTFILE←"MTA0:X.X"; ONLY MTA0 OR MTA1 *
SETZM MTA ;MAGTAPE FLAG ;*
MOVE 1,SBDEVN ;IS THE DEVICE MTA0? *
CAMN 1,[556441,,200000] ; = MTA0 *
JRST .+3 ;*
CAME 1,[556441,,210000] ; = MTA1 *
JRST INIDS5 ;*
SETOM MTA ;YES, SET THE FLAG ;*
SETZM MAXSMP ;SO HEADER WON'T LIE ABOUT IT ;*
SKIPN SAVCNT ;CAN'T DO 'SAVES' WITH MTA0 *
;; SKIPN SAVIT ;CAN'T DO 'SAVES' WITH MTA0 *
JRST .+3 ;*
OUTSTR [ASCIZ/CAN'T DO 'SAVES' WHEN USING MTA.
/] ;*
;; SETZM SAVIT ;*
SETZM SAVCNT ;*
MOVE 1,MTADUR ;HAS DURATION BEEN SET? *
JUMPE 1,INIDS6 ;NO *
FMPR 1,SRATE ;TO GET NUM. OF SAMPLS *
IFE KI10SW,< KAFIX 1,233000 > ;*
IFN KI10SW,< KIFIX 1,1 > ;*
MOVEM 1,TIME ;TIME=SMPL TOTAL, FIXED *
SETZM MTADUR ;RESET IT TO 0 *
JRST INIDS5 ;*
INIDS6: OUTSTR [ASCIZ/ HEADER WILL NOT INCLUDE DURATION.
/] ;*
;**********************MAGTAPE****************************
INIDS5: MOVEI F,TODSK ;DSK IS OPTION 2
PUSHJ P,PLINI2 ;CALL THE BUFFER ALLOCATION
PUSHJ P,MAKBUF
PUSHJ P,ENTFIL
; Sound file headers
;As of 29 March 1977, a sound file header looks like...
; WD 0 - 525252525252
; WD 1 - Clock rate
; has code in LH, actual rate in RH
; code=0 for 6.4Kc (or anything else)
; =1 for 12.8Kc, =2 for 25.6Kc, =3 for 51.2Kc
; =5 for 102.4Kc, =6 for 204.8Kc
; WD 2 - pack
; 0 for 12 bit
; 1 for 16 bit (18 bit)
; 2 for 9 bit floating point incremental
; 3 for 36-bit floating point
; N>9 for N bit bytes in ILDB format
; has # samples per word in LH.
; WD 3 - # channels
; 1 for MONO
; 2 for STEREO
; 4 for QUAD
; WD 4 - Maximum amplitude (if known)
; is a floating point number
; is zero if not known
; is maximum magnitude (abs value) of signal
; WD 5 - is exact number of samples.
; WDs 6-77 Reserved for future expansion
; WDs 100-177 Text description of file (in ASCIZ format)
;
↑WRTHDR:
PUSH P,C ; [IRC] GET AN AC.
MOVE C,SBHDR ; [IRC] GET BUFFER ADDRESS
ADDI C,2 ; [IRC] WELL, ALMOST
HRLZI B,(C) ; SET UP A BLT POINTER
HRRI B,1(C)
SETZM (C) ;****** [IRC] CLEAR OUT HEADER
BLT B,177(C)
MOVE T,[525252525252]
MOVEM T,0(C) ; [IRC] STICK IN HEADER
FIXR T,SRATE ;Take and round the sampling rate
;Check for known speed
MOVEI A,NHDRSP-1 ;Search speed table
HDLP1: CAME T,HDRSPT(A)
SOJG A,HDLP1
HRL T,A ;Put actual speed in left half
MOVEM T,1(C) ; [IRC]
;Check for special packing modes
IFE KI10SW,< MOVE T,BITS
KAFIX T,233000 >
IFN KI10SW,< KIFIX T,BITS >
SETZ B,
CAIE T,=12
AOJ B,
MOVEI A,3
SUB A,B ;PUT NUM SMPLS/WD IN LFT. HALF (3 OR 2 ONLY.)
HRL B,A
MOVEM B,2(C) ;PUTS 0 FOR 12, 1 FOR 18 BIT PACKING ONLY.
IFE KI10SW,< MOVE T,NCHNS
KAFIX T,233000 >
IFN KI10SW,< KIFIX T,NCHNS > ;Output number of channels
MOVEM T,3(C) ; [IRC]
IMUL T,TIME ;NCHNS*TIME=TOTAL SMPLS
MOVEM T,5(C) ;Gives total sample count. (6TH WD)
FLTR T,MAXSMP ;Put out max. sample we know about(flting pt.)
MOVEM T,4(C) ; [IRC] (5TH WD)
SKIPE MTA ;*********** MAGTAPE ?? ***********
JRST MTAHDR ;******* YES *******
HRLZI A,-200 ; [IRC] MAKE UP A IOWD
HRRI A,-1(C)
GETSTS SBCHAN,B ; [IRC] GET OUR STATUS
PUSH P,B ; SAVE IT
SETZ B,
SETSTS SBCHAN,17 ; [IRC] CHANGE TO DUMP MODE
OUTPUT SBCHAN,A ; [IRC]
POP P,B ; [IRC] GET BACK OLD STATUS
SETSTS SBCHAN,(B)
JRST HDRSPT-2
MTAHDR: MOVE A,SBPTR ;******** MAGTAPE *******
ADDI A,200 ; CAN'T USE 'SAVCNT' *
MOVEM A,SBPTR ;BECAUSE BUFFERS MIXUP ;*
OUT SBCHAN, ;********** MAGTAPE ******
POP P,C ; [IRC]
POPJ P, ;Next output will put out header
;Header speed table
HDRSPT: =6400
=12800
=25600
=51200
=102400
NHDRSP==.-HDRSPT
; Routines to Make File Names, and Keep the System Happy
BUFOUT: AOS SBUSET ;Update USETO pointer
OUT SBCHAN,
POPJ P,
WARN <Output error?>
COMMENT ⊗ Error detected while writing out sample buffer ⊗;
POPJ P,
FINFIL: JFCL ;BUFFERED I/O?
PUSHJ P,BUFOUT ;YES
CLOSE SBCHAN, ;WRITE END OF FILE
MOVE A,BLKNUM
JSA RA,SAVER ;SAVE A DUMP FILE
SKIPN QUIET
PUSHJ P,STATS ;PRINT STATISTICS
SKIPN QUIET
TYPSTR [ASCIZ/ /]
PUSH P,SBHDR ;SAVE HEADER FOR BUFFER RING (OPEN CLOBBERS THESE!)
PUSH P,SBPTR ;SAVE BYTE POINTER
OPEN SBCHAN,SBDEVC
ERROR <Can't re-INIT output device.>
COMMENT ⊗ Someone else it probably using it. ⊗;
POP P,SBPTR ;RESTORE BYTE POINTER
POP P,SBHDR
MOVE A,SBHDR ;Go thru buffer ring clearing use bits
PUSH P,B ;Save a register
MOVSI B,400000
CLRRNG: ANDCAM B,(A) ;Clear use bit
HRR A,(A) ;Pickup next buffer
CAME A,SBHDR ;Done yet?
JRST CLRRNG
POP P,B ;Restore register
AOS BLKNUM
HLLZ 1,SBFILN+1 ;INCREMENT EXTENSION
MOVE SBFILN+3
MOVEM SAVPPN# ;SAVE THE PPN
JRST[ SETZM SBFILN+3 ;;;MOVE 0,SBFILN+3 ;Save PPN over LOOKUP
RSBLOK: LOOKUP SBCHAN,SBFILN ;LOOKUP file to extend it
JRST[ ERROR <Can't find file just written to extend it>
COMMENT ⊗ The music program saves its computation in a way that could be
continued from. Part of this involves closing the output file and then
opening again to extend it. However, upon trying to open it, the file
could not be found!! Run your .SAV file after figuring out where the
file disappeared to ⊗;
JRST RSBLOK]
RSBENT: SETZM SBFILN+3
ENTER SBCHAN,SBFILN
JRST[ WARN <Someone is reading the sound file you are trying to write>
JRST RSBENT]
USETO SBCHAN,@SBUSET ;Move to remembered end of file.
MOVE SAVPPN
MOVEM SBFILN+3 ;GET BACK PROPER PPN
JRST FINFI2] ;Finish setting up for more output.
ENTFIL: SETZM SBFILN+3
ENTER SBCHAN,SBFILN ;ENTER THE FILE NAME
ERROR <Can't OPEN output file>
COMMENT ⊗ Usually this means the file is protected or already being
written. ⊗;
FINFI2:
MOVEI A,SBCHAN ;Display progress of output file with WHO line
SHOWIT A,
OUT SBCHAN,
JRST .+2
ERROR <Can't setup buffers for output>
COMMENT ⊗ This error is probably due to some change to I/O in system. ⊗;
SKIPG A,SAVCNT ;Skip if save count specified
MOVE A,SBBLKS(F) ;SET NUMBER OF 128 WORD BLOCKS PER FILE
MOVEM A,SBBCNT
SETZM SBWC
POPJ P,
; Sample Output Routines For Each Device
DSKOUT:
SKIPE SAVCNT ;Ignore NOMAX if saving
SOSLE SBBCNT ;DON'T SAVE EVERY TIME THRU
JRST BUFOUT ; Output buffer and return
PUSHJ P,FINFIL ;Write out file and re-open to extend
POPJ P, ;Return
DSKFIN: PUSHJ P,FILLBF ;FILL REMAINDER OF BUFFER WITH 4000'S
;AND PRINT WORD COUNT, ETC.
CLOSE SBCHAN, ;SAVE, SET UP FILES, ETC.
DSKFI2: MOVE THIS,SBBOTT ;GET LOWER OF TWO OUTPUT
;DECREMENT TO POINT TO BEGINNING OF
;FREE STORAGE BLOCK TO BE RELEASED
RELEAS SBCHAN,;Finished Doing Output, Close and Release Space
MOVE SSIZES(F)
ADDM BEGFREE
POPJ P, ;RETURN
FILLBF:
USETO SBCHAN,1 ;Back to beginning of file
OUT SBCHAN, ;Setup buffers for WRTHDR
SKIPN MTA ;************************************
PUSHJ P,WRTHDR ;Write out header
STATS: TYPSTR [ASCIZ/
/]
JRST [ PUSH P,[SBFILN]
PUSHJ P,PRTFLN
JRST STATS1]
STATS1: TYPSTR [ASCIZ/ Time = /]
MOVE A,TIME
CAME H,[XWD 200000,0]
SUB A,H
FSC A,233
FDVR A,SRATE
PUSHJ P,OUTFLT ;PRINT REAL TIME
TYPSTR [ASCIZ/ Max. sample = /]
MOVE A,MAXSMP ;PRINT MAXIMUM SAMPLE
PUSHJ P,DECPNT
POPJ P,
SUBTTL Sample Buffer Tables, etc.
SBPTRS: POINT 12,0 ;BYTE POINTER
POINT 18,0
POINT 18,0
POINT 18,0
BYTWRD: 3 ;BYTES/WORD
2
2
2
SSIZES: 0 ;OPTIMAL BUFFER SIZE
0
DBFNUM*(DBLKSZ+3)+1 ;EXTRA WORD TO PREVENT EXTRA K OF
3*(DBLKSZ+3)+1 ;CORE TO BE ALLOCATED
SBBLKS: 0
SBDNUM
SBDNUM
BUFNUM: 0 ;(ENTRY NOT USED);TABLE OF RECORD SIZES
0 ;(ENTRY NOT USED)
DBFNUM ;DISK RECORD SIZE
↑OUTTAB:0 ;TABLE OF OUTPUT ROUTINES
0
DSKOUT
↑FINTAB:0 ;TABLE OF ROUTINES TO CALL AT END
0
DSKFIN
↑PLYOPT:0 ;USED TO DETERMINE WHICH ROUTINE TO CALL TO
;DO OUTPUT, ETC.
SBBCNT: 0 ;IF OUTPUT IS TO DISK, THE NUMBER OF BLOCKS
;REMAINING TO BE WRITTTEN ON THIS FILE
↑MTSYSA:[-1] ;ADDRESS OF WORD USED TO DETECT 'INTERRUPT' TO COMPUTATION
;OF SAMPLE
↑SBDEVC: 0 ;MODE
↑SBDEVN: 0 ;DEVICE NAME
0 ;POINTER TO BUFFER HEADER
↑SBFILN:BLOCK 4 ;FILE NAME
↑SBHDR: 0 ;BUFFER HEADER
↑SBPTR: 0 ;BYTE POINTER
↑SBCNT: 0 ;NUMBER OF BYTES LEFT IN BUFFER
SBWC: 0
↑NBYTES: 0 ;NUMBER OF BYTES/WORD
SBUSET: 1 ;USETO pointer
;;↑SAVCNT: 0 ;Flag and/or inverval (in buffers) between saves
↑SBIOWD:0 ;IOWD FOR SAMPLE BUFFER
↑BLKNUM:0 ;NUMBER OF THE BLOCK (FILE) BEING WRITTEN ON
;THE UDP(DISK)
SBBOTT: 0 ;POINTER TO BEGINNING OF BUFFER BEING FILLED
↑PZEROS:BLOCK 4
BEND SMPOUT
SUBTTL SAVER
BEGIN SAVER
; (INSERTED 11/3/69)
; TO DUMP CORE IMAGE
; CREATE A FILE OF THE CURRENT CORE IMAGE.
; PICK UP THE USER'S INPUT FILE NAME STORED
; IN DLK AND CREATE A FILE CALLED:
; "NAME.SAV"
; WHERE NAME IS THE INPUT FILE NAME.
;
; THE SWAP UU0 WILL BE USED WHICH CLOSES ALL
; ACTIVE DEVICES.
INTERNAL SAVER
↑SAVER: 0
MOVEM 17,ACS+17 ;SAVE REGISTERS
MOVEI 17,ACS
BLT 17,ACS+16
MOVE 0,SCP ;BASE OF INPUT BUFFER
HRRZ T,IBUF ;CURRENT BUFFER
SUBI 0,-BUF1-1(T) ;DIFFERENCE
MOVEM 0,PLIST+LPLIST-10
SKIPN T,DLK ;INPUT FILE NAME
MOVSI T,'SAV' ;DEFAULT FILE NAME
MOVEM T,SWPTBL+1
MOVE T,JOBREL ;GET LENGTH OF CORE IMAGE (SYSTEM THINKS
;THAT PART OF THE CORE IMAGE IS BUFFERS
;AND DOES NOT SAVE ALL OF IT.)
AOJ T, ;ADD 1 TO GET CORE SIZE
ASH T,-=10 ;DIVIDE BY 1024
HRLM T,SWPTBL+3 ;SET SAVE SIZE IN 1K BLOCKS
SETOM SAVDON ;INDICATE SAVE WAS DONE
MOVSI T,SWPTBL ;ADDR OF 5 WORD BLOCK IN LEFT PART OF T
SWAP T,
SETZM RUFLAG ;CLEAR FLAG INDICATING RESTART
JRST RETR+1
RETR: SETOM RUFLAG ;SET FLAG INDICATING RESTART
MOVE P,[XWD -10,PLIST+LPLIST-10] ;PICK UP ACCUM P
MOVEI FL,RESTART ;RESTORE RESTART FLAG
SOS RECCT ;BACK UP TO PREVIOUS INPUT RECORD.
PUSHJ P,SETUP ;JUMP TO RESTORE FILES
POP P,SCP
MOVEI GO ;FIX UP STARTING ADDRESS
HRRM JOBSA
MOVE [SIXBIT/MUSIC/]
SETNAM
MOVSI 17,ACS ;RESTORE REGISTERS
BLT 17,17
JRA 16,(16)
↑RUFLAG: 0 ;FLAG INDICATING PROGRAM STARTED FROM A .SAV FILE
↑SAVDON: 0 ;FLAG INDICATING PROGRAM HAD BEEN SAVED AT LEAST ONCE
ACS: BLOCK 20 ;REGISTER SAVE AREA
↑SWPTBL:SIXBIT /DSK/ ;DEVICE FOR SWAP
SIXBIT /SAV/ ;FOR FILENAME
SIXBIT /SAV !/ ;FILENAME.SAV (SAVE SEGMENT ALSO)
XWD 0,RETR ;CORE SIZE (0=USE WHAT YOU NEED)
0 ;END OF LIST
BEND SAVER
SUBTTL Storage Management
;GET BLOCK OF FREE STORAGE
;CALL WITH -SIZE IN T, RETURNS ADDRESS IN T, CLOBBERS 0
GFS: PUSH P,A ;SAVE A
HRRO A,T ;TO BE SURE (AND TO NOT MUNG T YET)
ADD A,BEGFREE ;DECREMENT BEGINNING OF FREE STORAGE. *****
TLNE A,777777
PUSHJ P,DRYROT ;BUG TRAP
CAMG A,JOBFF ;ROOM LEFT? ****
COREFULL ;NO, LET'S SEE IF WE CAN GET SOME
JRST GFS+1 ;WE GOT MORE SPACE! TRY AGAIN
MOVEM A,BEGFREE ;RETURN ADDRESS IN T *****
EXCH A,T
POP P,A ;RESTORE A
POPJ P,
;GET BLOCK OF PERMANENT STORAGE
;CALL WITH SIZE IN T, RETURNS ADDRESS IN T
GPS: HRRZ T,T ;JUST IN CASE...
ADD T,JOBFF ;ADD TO TOP OF PERMANENT STORAGE
CAML T,BEGFREE ;*****
COREFULL ;NO, LET'S SEE IF WE CAN GET SOME
JRST GPS+2 ;WE GOT MORE SPACE! TRY AGAIN
HRLM T,JOBSA
EXCH T,JOBFF ;RETURN ADDRESS IN T *****
POPJ P,
.CORFL: PUSH P,0 ;SAVE AC0
MOVE JOBREL ;IS FREE STORAGE IN USE?
CAME BEGFREE
JRST [ ;YES, BARF!
SETOM GETMORE ;SET FLAG TO GET CORE UPON RESTART
MOVE -1(P)
MOVEM LSTFUL ;SAVE ADDRESS OF CALLER FOR DEBUGGING
POP P,0
ERROR <Storage full!>
POPJ P,]
SKIPN NOMSG ;Don't print if in quiet mode
OUTSTR[ASCIZ/
Getting more core.../] ;NO, LET'S GET SOME MORE
MOVE JOBREL
ADDI 2000
CORE
JRST [ ERROR<Can't expand core!>
COMMENT ⊗ Could get enough core. You lose. ⊗;
JRST .CORFL]
MOVE JOBREL
MOVEM BEGFREE
SKIPN NOMSG
OUTSTR[ASCIZ/
/]
POP P,0
AOS (P)
POPJ P,
;CALLED FROM INIDAC
SETCOR: CORE
JRST [ ERROR<Can't expand core>
HALT $.]
MOVE JOBREL
MOVEM BEGFREE
POPJ P,
;SIXOUT and PRTFLN
SIXOUT: HRLI 440600 ;MAKE BYTE POINTER
LOOPTS: SOJL T1,OTTYRT ;IF DONE, FLUSH TTY BUFFER
ILDB T,0
JUMPE T,OTTYRT
SIXOU3: ADDI T,40
TYPCHR T
JRST LOOPTS
;PRINT FILE NAME
PRTFLN: MOVEI T1,6
MOVE -1(P) ;GET ADDRESS OF FILE NAME
PUSHJ P,SIXOUT
ADDI 1 ;LOOK AT FILE NAME
HLRZ T1,@0 ;GET EXTENSION
JUMPE T1,PRTFL1 ;DON'T PRINT NULL EXTENSION
TYPCHR ["."]
MOVEI T1,3
PUSHJ P,SIXOUT
PRTFL1: TYPCHR ["["]
MOVE -1(P)
ADDI 3
SKIPN @0
JRST [ SETZ T1,
DSKPPN T1,
MOVEM T1,@0
JRST PRTFL2]
PRTFL2:
HRLI 440600 ;MAKE BYTE POINTER
PUSHJ P,[PRTFL3: MOVEI T1,3
ILDB T,0
SOJL T1,OTTYRT ;IF DONE, FLUSH TTY BUFFER
JUMPE T,PRTFL3+1
JRST SIXOU3]
TYPCHR [","]
HRLI 220600 ;BYTE POINTER TO MIDDLE OF PPN
PUSHJ P,PRTFL3
TYPCHR ["]"]
SUB P,[XWD 2,2]
JRST @2(P)
TXTOUT: 0
TYPSTR @0
JRST @TXTOUT
;PRINT SYMBOL TABLE ENTRY IN ENTITY IN A
PRNTSYM:HRRZI @A ;GET SYMBOL
ADD [440577777777] ;MAKE A 6 BIT POINTER
ILDB T1, ;GET LENGTH OF SYMBOL
SUBI T1,5 ;HOW MANY IN SECOND PART
PUSH P,T1 ;SAVE FOR LATER
MOVEI T1,5 ;CHARACTER COUNT
PUSHJ P,PRNTS2 ;SIXBIT OUTPUT ROUTINE
POP P,T1 ;RECOVER CHARACTER COUNT
ADDI 0,1 ;SKIP GOODBITS WORD
JUMPLE T1,OTTYRT;DON'T BOTHER IF COUNT<1
HRLI 000600 ;ANOTHER POINTER
PUSHJ P,PRNTS2
OTTYRT: OUTPUT TTY, ;FLUSH TTY BUFFER
POPJ P,
PRNTS2: SOJL T1,CPOPJ
ILDB T,0
JUMPE T,CPOPJ
ADDI T,40
CAIN T,"." ;MAP '.` INTO '_`
MOVEI T,"_"
TYPCHR T
JRST PRNTS2
DCLMSG: SKIPE NOMSG
JRST DCLRET
MOVE BLEVEL ;INDENT ACCORDING TO NUMBER OF BLOCKS DEEP
SOJL 0,[MOVE @(P) ;GET STRING
TYPSTR @0 ;PRINT IT FOLLOWED BY
PUSHJ P,PRNTSYM ;IDENTIFIER
TYPSTR [ASCIZ/
/] ;AND A CRLF
DCLRET: AOS (P)
POPJ P,]
TYPCHR [" "] ;TWO SPACES PER LEVEL
TYPCHR [" "]
JRST DCLMSG+1
;RDBUF - READ A BUFFER
RDBUF: MOVSI A,'TTY'
CAME A,DNAM ;IS INPUT DEVICE A TTY ?
TLO FL,NOSTAR ;NO. SUPRESS THE *.
TLZN FL,NOSTAR ;PRINT IF NOSTAR NOT ON.
OUTSTR [ASCIZ/
>/] ;YES. TYPE CR LF *.
USETI DT,@RECCT ;POSITION INPUT FILE TO RIGHT RECORD.
AOS RECCT ;ADD 1 TO RECORD CTR
SETOM NOISCP# ;Set flag saying ISCP is invalid
IN DT,0 ;READ NEW INPUT BUFFER.
JRST RDBUF2 ;OK, SET IT UP
STATZ DT,20000 ;ERROR, END OF FILE SEEN ?
JRST SETUP ;YES.
WARN <INPUT ERROR>
RDBUF2: MOVEI 4 ;MAKE SURE 0 WORD TERMINATBES IT.
ADD ICCNT ;CHAR. COUNT +4/5 IS WORD COUNT.
MOVEI A,5 ;BECAUSE WE DON'T WANT TO LOSE B.
IDIVM A ;SEE? NO RANDOM REMAINDER !!
ADD A,SCP ;ADD BASE ADDRESS.
IBP A ;BAGBITING SYSTEM.
SETZM (A) ;ZERO IT.
MOVE SCP
MOVEM ISCP# ;SAVE FOR ERROR PRINTOUT.
SETZM NOISCP ;Clear flag saying ISCP is invalid
POPJ P,
SUBTTL Numeric Output Routines
BEGIN NUMOUT
;OUTPUT IN OCTAL
↑OUTOCT: EXCH A,(P) ;SAVE A, GET RET. ADR.
EXCH A,-1(P) ;SAVE RET. ADR., GET ARG.
PUSH P,B ;SAVE B
SETZ B,
PUSHJ P,OUTOC2
OUTPUT TTY, ;FLUSH TTY BUFFER
POP P,B
POP P,A
POPJ P,
OUTOC2:
; IDIVI A,8 ;PRINT OCTAL NUMBER FROM A.
LSHC A,-3
ROT B,3
HRLM B,(P) ;SAVE LOW ORDER DIGIT.
SKIPE A ;DONE ?
PUSHJ P,OUTOC2 ;NO. RECUR FOR REST OF DIGITS.
HLRZ B,(P) ;YES. GET HIGH ORDER DIGIT.
ADDI B,"0" ;CONVERT TO ASCII.
TYPCHR B ;OUTPUT DIGIT
POPJ P,
;CALL WITH NUMBER TO BE PRINTED IN A
;CLOBBERS A-B
↑DECPNT: PUSH P,C ;SAVE C
JUMPGE A,.+4 ;NEGATIVE
MOVNS A ;YES
MOVEI B,"-" ;OUTPUT A "-"
PUSHJ P,TTYCHR
PUSH P,[DECRET];SET UP RETURN
MOVNI C,1 ;SET FAKE DECIMAL POINT
JRST FLTOU3 ;JUMP INTO FLOATING CHARACTER
DECRET: POP P,C
MOVEI B,40
PUSHJ P,TTYCHR
JRST OTTYRT ;OUTPUT TTY BUFFER AND RETURN
↑OUTFLT: PUSH P,C ;SAVE C
JUMPE A,DECPNT+1;TEST FOR ZERO
MOVEI C,7 ;INIT. EXPONENT
JUMPGE A,.+4 ;NEGATIVE NUMBER?
MOVNS A ;NEGATE NUMBER
MOVEI B,"-" ;OUTPUT A "-"
PUSHJ P,TTYCHR
TLNN A,377000 ;IS IT FLOATING?
JRST DECPNT+1 ;NO! USE DECPNT
CAML A,[999999.5] ;NORMALIZE
JRST .+3
FMPR A,[10.0]
SOJA C,.-3
CAMGE A,[9999999.5]
JRST .+3
FDVR A,[10.0]
AOJA C,.-3
CAIG C,7 ;WILL IT FIT IN FIXED POINT?
JUMPGE C,FLTOU2 ;IF DEC. EXP. BETWEEN -1 AND 5, YES
SUBI C,1 ;TURN INTO ACTUAL EXP.
PUSH P,C ;SAVE EXPONENT
MOVEI C,1
PUSHJ P,FLTOU6 ;CALL SELF TO OUTPUT MANITISSA
MOVEI B,"E" ;OUTPUT "E" (FOR EXPONENT!)
PUSHJ P, TTYCHR
POP P,A ;GET REAL C
JRST DECPNT+1 ;CALL INTEGER OUTPUT TO RETURN IT
FLTOU2: JUMPN C,.+3 ;DEC. EXP =-1
PUSHJ P,FLTOU5 ;PRINT "0."
PUSHJ P,FLTOU4
PUSHJ P, FLTOU6 ;OUTPUT MANTISSA
SOJL C,DECRET ;IF POSITIVE, PRINT TRAILING ZEROS
PUSHJ P,FLTOU5
JRST .-2
FLTOU6:
FIXR A,A ;FIX THE MANTISSA
IDIVI A,=10
JUMPE A,FLTOU3+1;IN CASE OF POWERS OF 2
JUMPE B,.-2 ;IGNORE TRAILING ZEROS
JRST .+2 ;SKIP THE DIVIDE
FLTOU3: IDIVI A,12 ;PRINT DECIMAL INTEGER FROM A.
HRLM B,(P) ;SAVE LOW ORDER DIGIT.
SKIPE A ;DONE ?
PUSHJ P,FLTOU3 ;NO. RECUR FOR REST OF DIGITS.
HLRZ B,(P) ;YES. GET HIGH ORDER DIGIT.
ADDI B,"0" ;CONVERT TO ASCII.
SOJN C,TTYCHR ;DECIMAL POINT?
PUSHJ P,TTYCHR ;OUTPUT DIGIT
FLTOU4: MOVEI B,"." ;AND "."
JRST TTYCHR
FLTOU5: MOVEI B,"0" ;PRINT A ZERO
TTYCHR: TYPCHR B
POPJ P,
BEND NUMOUT
; Read number from TTY
GETNUM: PUSH P,0 ;SAVE 0
SETZ 1,
INCHWL
CAIN 15
JRST [ INCHWL ;EAT THE LINE FEED
POP P,0 ;RESTORE 0
POPJ P,];RETURN
SUBI "0"
IMULI 1,=10
ADD 1,0
CAIG =9
JUMPGE GETNUM+2
OUTSTR [ASCIZ/ILLEGAL CHARACTER IN NUMBER
/]
JRST GETNUM+1
;*****************************************************************
COMMENT ⊗ Character string conversion package
This package is a collection of frequently used conversion
subroutines, such as convert integer to character stream and convert
character stream to sixbit. The character stream source or
destination are defined by a PDP-10 instruction, such as
PUSHJ P,GETCHR. All character stream destinations are expected to
return a character in accumulator 1 and all character stream
destination are expected to recieve its character in accumulator 1.
Subroutines which return arguments always return their arguments in
accumulator 1 and if a break character is to be return, it will be
in accumulator 0. Character streams should not modify any other
accumulators. These subroutines are:
RDINT(Integer BASE; Character_source OPCODE);
Convert character stream into integer, in specified base.
WRINT(Integer N, BASE; Character_destination OPCODE);
Convert integer into character stream, in specified base.
RDSIX(Integer SIXBIT; Character_source OPCODE, Breaktable BRKTAB);
Convert sixbit word into character stream.
WRSIX(Integer SIXBIT; Character_destination OPCODE);
Convert sixbit word into character stream.
RDFLO(Operation OPCODE);
Convert character stream into real, in specified base. (UNIMPLIMENTED)
WREFLO(Real N,CHARACTER_COUNT,CONTROL_WORD; Character_destination
OPCODE);
Convert floating point number into character stream of specified
format. CONTROL_WORD is of form. (See FORTRAN for details on this
format).
XWD <characters to left of decimal point>,<width of field>
RDFILN(Array FILBLK; Character_source OPCODE; Sixbit
DEFAULT_EXTENSION)
Convert a character string into system file name structure.
WRFILN(Array FILBLK; Character_destination OPCODE)
Convert system file name structure into a character string.
WRASCZ(Ascizstring S; Character_destination OPCODE)
A break table is the standard system format four word table
representing which characters are break characters. See UUO Manual
for details. Briefly,
Word 0 contains bits for <null> thru #,
Word 1 contains bits for $ thru G,
Word 2 contains bits for H thru k
Word 3 contains bits for l thru <bs>
Note: LIBRARY.TMP should be a copy of either HEADER.FAI or EXPHD.FAI
⊗;
;;ENTRY RDIOSP ↔ TITLE RDIOSP ↔EXTERNAL RDSIX
; Read a device name and file name into DEVBLK, returning terminator
; in AC 0 and AC 1. Default extension is used if none is given.
; Skip return if successful. If no device or file is given, do not
; alter DEVBLK and non-skip return
;DEVBLK: SIXBIT/DEVNAM/
; XWD OUTPTR,INPTR
; SIXBIT/FILNAM/
; SIXBIT/EXT/
; 0
; SIXBIT/PRJPRG/
RDIOSP: PUSH 17,2
MOVE 2,-4(17)
MOVSI 1,446353 ;DSKM ; FOR IRCAM*******************
MOVEM 1,(2)
PUSHJ 17,RDIOSP+50 ;Read SIXBIT
JUMPE 1,RET
CAIE 0,":"
JRST NODEV
MOVEM 1,(2) ;Set device name
PUSHJ 17,RDIOSP+50
NODEV: MOVEM 1,2(2)
HLLZ 1,-2(17) ;Fetch default extension
MOVEM 1,3(2)
SETZ 1,
CALLI 1,24
MOVEM 1,5(2)
CAIE 0,"." ;Extension coming?
JRST NOTEXT
PUSHJ 17,RDIOSP+50 ;Yes, read it
HLLZM 1,3(2)
NOTEXT: CAIE 0,"[" ;PPN coming?
JRST SKRET ;No, return
PUSH 17,RDIOSP+60 ;Read project
PUSH 17,-4(17)
PUSHJ 17,RDINT ;(Stanford likes it PPN's right justified)
HRLM 1,5(2)
CAIE 0,","
JRST NOTCOM ;Assume he wants same programmer area
PUSH 17,RDIOSP+60 ;Read project
PUSH 17,-4(17)
PUSHJ 17,RDINT ;(Stanford likes it PPN's right justified)
HRRM 1,5(2)
NOTCOM: CAIE 0,"]" ;Don't worry if no ']'
JRST RDIOSP+44
XCT -3(17)
MOVE 0,1
;Skip return
SKRET: AOS -1(17)
;Non-skip return
RET: MOVE 1,0
POP 17,2
JRST POP3J.
PUSH 17,-4(17)
PUSH 17,RDIOSP+61
PUSHJ 17,RDSIX
POPJ 17,0
-11 ;;.PLEVEL←←.PLEVEL+2 ;(Set stack level for subr)
;Read sixbit with appropriate break characters
RDFIL1: FDVRB 16,37600 ;;CALL(RDSIX,OPCODE,[FILBRK])
374000 ;;POP0J
7,,600000
10
RDIOSP+54
POP1J.: SUB 17,POP4J.+2
JRST @2(17)
POP2J.: SUB 17,POP4J.+3
JRST @3(17)
POP3J.: SUB 17,POP4J.+4
JRST @4(17)
POP4J.: SUB 17,POP4J.+5
JRST @5(17)
2,,2
3,,3
4,,4
5,,5
;;ENTRY WRIOSP ↔ TITLE WRIOSP ↔EXTERNAL WRSIX
;;.INSERT LIBRARY.TMP
;;NSUBR WRIOSP,DEVBLK,OPCODE
;; ACCUMULATORS{2,P2}
WRIOSP: PUSH 17,2
EXCH 3,-3(17)
MOVSI 2,440603
LOOP1: ILDB 1,2
JUMPE 1,CONT1
ADDI 1,40
XCT -2(17)
CONT1: CAMN 2,WRIOSP+43
JRST WRIA
CAMN 2,WRIOSP+44
JRST WRIB
WRIC: CAMN 2,WRIOSP+45
JRST LOOP1
EXTDON: SKIPN 5(3)
JRST PPNDON
MOVEI 1,"["
XCT -2(17)
HLRZ 5(3)
PUSH 17,0
PUSH 17,WRIOSP+42
PUSH 17,-4(17)
PUSHJ 17,WRINT
MOVEI 1,54
XCT -2(17)
HRRZ 5(3)
PUSH 17,0
PUSH 17,WRIOSP+42
PUSH 17,-4(17)
PUSHJ 17,WRINT
MOVEI 1,135
XCT -2(17)
PPNDON: EXCH 3,-3(17)
POP 17,2
JRST POP2J.
10
603,,0
603,,2
IMUL 14,3(3)
WRIB: HLLZ 1,3(3)
JUMPN 1,.+2
JRST EXTDON
MOVEI 1,56
XCT -2(17)
JRST WRIC
WRIA: ADDI 2,1
MOVEI 1,72
XCT -2(17)
JRST LOOP1
;;ENTRY RDINT ↔ TITLE RDINT
;;.INSERT LIBRARY.TMP
;Subroutines RDINT,WRINT
;;NSUBR RDINT,BASE,-2(17)
RDINT: SETZ 0,
LOOP: XCT -1(17)
CAIL 1,"0"
CAILE 1,"9"
JRST RDI
IMUL -2(17)
ADDI 0,-60(1)
JRST LOOP
RDI: EXCH 1
JRST POP2J.
;;ENTRY WRINT ↔ TITLE WRINT
;;.INSERT LIBRARY.TMP
;;NSUBR WRINT,INTEGER,BASE,-2(17)
; Convert integer into character stream, in specified base.
WRINT: MOVE 1,-3(17) ;FETCH ARG AND MOVE RET. ADR.
POP 17,-3(17)
POP 17,WRINT+26
POP 17,WRINT+25
PUSH 17,2
PUSH 17,WRINT+27
L1: JUMPGE 1,L2 ;TEST FOR NEGATIVE NUMBER.
MOVM 2,1 ;PRINT MINUS SIGN.
MOVEI 1,"-"
XCT WRINT+26
MOVE 1,2
L2: IDIV 1,WRINT+25 ;MODULO TEN AND SAVE.
HRLM 2,0(17)
SKIPE 1
PUSHJ 17,WRINT+13
HLRZ 1,0(17)
ADDI 1,60
XCT WRINT+26 ;RESTORE & PRINT.
POPJ 17,0
RETX: POP 17,2
POPJ 17,0
0
0
WRINT+23
;;ENTRY RDSIX ↔ TITLE RDSIX
;;.INSERT LIBRARY.TMP
;;NSUBR RDSIX,-2(17),BRKTAB
; Read SIXBIT, where BRKTAB is address of 4 word bit table indicating what
; characters are terminators.
; If there are more than 6 characters, additional characters are ignored.
;
; Returns SIXBIT in 1
; Terminating character in 0.
;; ACCUMULATOR{T1,2}
RDSIX: PUSH 17,2 ;Save AC's we'll need
PUSH 17,3
MOVSI 3,440600 ;Pointer to where SIXBIT will go
SETZ 0,
LOOPX: XCT -4(17) ;Pick up a character
PUSH 17,1
IDIVI 1,=36
ADD 1,-4(17)
MOVE 1,(1)
LSH 1,(2)
JUMPL 1,RETZ ;1 means terminator
POP 17,1
CAIGE 1,"a"
SUBI 1,40
CAME 3,RDSIX+26 ;Check for more than 6 characters
IDPB 1,3 ;Pack into word
JRST LOOPX
RETZ: MOVE 1,0 ;Get SIXBIT to return
POP 17,0 ;Get back terminator
POP 17,3 ;Restore saved AC's
POP 17,2 ;Restore saved AC's
JRST POP2J.
600,,0
;;ENTRY WRSIX ↔ TITLE WRSIX
;;.INSERT LIBRARY.TMP
;;NSUBR WRSIX,SIX,-2(17)
; Convert sixbit word into character stream.
WRSIX: PUSH 17,0
MOVEI 0,6
PUSH 17,WRSIX+12
LOOPW: ILDB 1,(17)
ADDI 1,40
XCT -3(17)
SOJG LOOPW
POP 17,0
POP 17,0
JRST POP2J.
ANDCB 14,-3(17)
SWBRK: -1 ;<null> thru #
BYTE (29) -1 (7)0 ;$ thru G,
BYTE (19) 0 (6) -1 (11) 0 ;H thru k
BYTE (15) 0 (5) -1 ;l thru <bs>
SUBTTL Tables and Flags
PLIST: BLOCK LPLIST
PDLIOWD:IOWD LPLIST,PLIST
OSTK: BLOCK LOSTK
RQ1: BLOCK LRQ ;THE RUN QUEUE, CLOUMN ONE.
RQ2: BLOCK LRQ ;COLUMN TWO.
;;PATCH: BLOCK 50 ;LET'S HEAR IT FOR DEBUGGING!
;Symbol table pointers
BUCTBL: FOR I←0,BUCKNO-1,1 < CAT(SYM,→I)↔ >
STRBUC: 0 ;HEAD OF STRING TABLE
NUMBUC: EXP C ;HEAD OF NUMBER TABLE
OUTFIL: NULLDV ;Pointer to default output specification, initially undefined
INFILE: 0 ;NAME FOR READIN FILE 1
INFIL2: 0 ;NAME FOR READIN FILE 2
INFIL3: 0 ;NAME FOR READIN FILE 3
INFIL4: 0 ;NAME FOR READIN FILE 4
;A COPY OF ABOVE FOR RESET COMMAND
SVAREA: FOR I←0,BUCKNO-1,1 < CAT(SYM,→I)↔ >
0 ;FOR STRBUC
C ;FOR NUMBUC
NULLDV ;FOR POUTSP
IARR1: ;; HERE BEGINS AN AREA WHICH IS ZEROED DURING
;; INITIALIZATION OF EACH COMPILATION.
UOTBL: BLOCK LUOTBL
ACS:
RACS: BLOCK 20 ;R-TIME AC TABLE
IACS: BLOCK 20 ;I-TIME AC TABLE
; THE FOLLOWING FLAGS MUST BE PUSHED AND MAY NOT BE BITS
; THESE ARE INITED TO 0
IONLY: 0 ;FLAG TO GENERATE ONLY I-TIME CODE
BLEVEL: 0 ;BLOCK LEVEL
RSTATE: 0 ;USED TO SET R-TIME ATTRIBUTES OF STATEMENT LISTS
NOTAC0: 0 ;FLAG INDICATING NOT TO USE AC0
LOGFLG: 0 ;IF 0 THEN TREAT '<` AS A COMMENT
UGEXPF: 0 ;SET WHEN WE WANT A U.G. TO RETURN A VALUE
UOPTR: -1 ;COUNT OF U SYMBOLS
IARR2:
; THESE GET SET TO -1
DONEFX: -1 ;FIXUP FOR WHILE-UNTIL-FOR LOOPS
-1
EXITFX: -1 ;FIXUP FOR BLOCK EXITS
-1
RETFIX: -1 ;FIXUP FOR RETURN STATEMENTS (ALWAY I-TIME CODE)
IARR5:
; PBASE(INSXR) ;SO THAT P MAY BE AN ARRAY
XWD INSXR,PBASE ;FW strikes again! FAIL once accepted the above line
LPA ;SIZE OF P ARRAY
IARR4:
PBASE: BLOCK LPA
OUTA: 0 ;CHANNEL A OUTPUT SAMPLE ACCUMULATED HERE.
OUTB: 0 ;CHANNEL B.
OUTC: 0 ;CHANNEL C.
OUTD: 0 ;CHANNEL D.
IARR3:
VLOC: 0
ILOC: 0
RLOC: 0
;DEBUGGING STUFF
LSTWRD: BLOCK 3 ;LAST WORD OF CODE EMITTED
↓LSTLOA:0 ;LAST PLACE CODE WAS LOADED
NULLDV: ASCIZ// ;No device, used to indicate MUSCMP to explicitly ask for it
VAR
LIT
MUSEND: END GO